home *** CD-ROM | disk | FTP | other *** search
/ Aminet 30 / Aminet 30 (1999)(Schatztruhe)[!][Apr 1999].iso / Aminet / game / think / plasma_src.lha / PLASMAD6.LST next >
File List  |  1996-12-28  |  96KB  |  4,017 lines
  1. ' Plasma Bubble. Amiga version. By Francis Irving.
  2. '
  3. ' Compiler Options:
  4. $%3
  5. $*&
  6. $m192072
  7. $S&
  8. $S>
  9. $E#
  10. $P>
  11. kon&=1 ! Change to 1 for compilation, 0 for interpreter, 1 for 3.51 interpreter
  12. '
  13. ' Yes! The graphics were drawn (on Degas Elite on an ST, loaded into ST GFA
  14. ' Basic, saved in a silly format taking up lots of room, sent down a serial
  15. ' cable to an Amiga, loaded into AmigaBasic and saved as ACBM, loaded into
  16. ' the ACBM-PUT$ GFA Basic program, then INLINEd into the program proper.
  17. '
  18. ' Why? First part was when I had an ST (don't worry, I've recovered) and
  19. ' wrote an ST version, then a friend tried to write an Amiga version in
  20. ' (shock) AmigaBasic (indrawn breath), and now I'm using GFA again.
  21. '
  22. ' Started:        3rd November  1990.
  23. ' Last Modified: 14th December  1990.
  24. '                13th February  1991.
  25. '                22nd June      1991.
  26. '                27th September 1991.
  27. '                 6th October   1991.
  28. '                17th May       1992.
  29. '                11th June      1992.
  30. '                 9th August    1992.
  31. '                23rd August    1992.
  32. '                30th September 1992
  33. '                17th December  1992
  34. '                 2nd July      1994
  35. '
  36. ' Fn: 155, 47+n, 126
  37. '
  38. ' Uncomment these for ASCII codes of strange keys
  39. ' OPENW #5
  40. ' DO
  41. '  i$=INKEY$
  42. '  IF i$<>""
  43. '    PRINT LEN(i$),ASC(MID$(i$,1)),ASC(MID$(i$,2)),ASC(MID$(i$,3))
  44. '  ENDIF
  45. ' LOOP
  46. '
  47. GOSUB init
  48. DO
  49.   GOSUB menu
  50.   SELECT menu&
  51.   CASE 1
  52.     GOSUB game
  53.   CASE 2
  54.     GOSUB edit
  55.   CASE 4
  56.     GOSUB opts
  57.   ENDSELECT
  58. LOOP
  59. '
  60. ' Program Control
  61. PROCEDURE init
  62.   er!=FALSE
  63.   ON ERROR GOSUB trap
  64.   GOSUB openscreens
  65.   GOSUB graphinit
  66.   GOSUB variables
  67.   GOSUB displaymove
  68.   GOSUB soundinit
  69.   FOR f&=1 TO 10
  70.     GOSUB soundplay(2,0)   ! this is an incredible kludge
  71.   NEXT f&
  72.   FRONTS sit&
  73. RETURN
  74. PROCEDURE trap
  75.   ON ERROR GOSUB trap
  76.   FRONTS 2
  77.   ~DisplayBeep(SCREEN(2))
  78.   PRINT ERR$(ERR)
  79.   EDIT
  80.   IF ERR=89
  81.     EDIT
  82.   ENDIF
  83.   RESUME leaveproc
  84. RETURN
  85. PROCEDURE game
  86.   GOSUB selectlevel
  87.   IF brk!
  88.     x$="Sorry, no level found with"
  89.     GOSUB text((height&/2)-10,1)
  90.     x$="that password."
  91.     GOSUB text((height&/2)+10,1)
  92.     GOSUB fade(15)
  93.     GOSUB pause
  94.     GOSUB fade(0)
  95.     CLEARW #sit&
  96.     GOTO ret
  97.   ENDIF
  98.   '
  99.   cancel!=FALSE
  100.   '
  101.   x$=default$
  102.   GOSUB text((height&/2)-60,1)
  103.   x$="Author: "+author$
  104.   GOSUB text((height&/2)-20,1)
  105.   x$="Diamonds Needed: "+STR$(needed&)
  106.   GOSUB text((height&/2),1)
  107.   x$="Pushable Walls: "+STR$(pushywall&)
  108.   GOSUB text((height&/2)+20,1)
  109.   x$="Map Type: "
  110.   SELECT map&
  111.   CASE 1
  112.     x$=x$+"Full"
  113.   CASE 0
  114.     x$=x$+"None"
  115.   CASE 2
  116.     x$=x$+"Progressive"
  117.   ENDSELECT
  118.   GOSUB text((height&/2)+40,1)
  119.   x$="Press fire or any key to play."
  120.   GOSUB text((height&/2)+80,1)
  121.   GOSUB fade(15)
  122.   GOSUB pause
  123.   GOSUB fade(0)
  124.   CLEARW #sit&
  125.   '
  126.   REPEAT
  127.     GOSUB backplay
  128.     IF NOT gotit!
  129.       x$="Hard luck. Do you want to"
  130.       GOSUB text((height&/2)-33,1)
  131.       x$="give "+default$+" just one more try?"
  132.       GOSUB text((height&/2)-22,1)
  133.       GOSUB yesno
  134.       GOSUB fade(0)
  135.       CLEARW #sit&
  136.       IF yesno&=2
  137.         cancel!=TRUE
  138.       ENDIF
  139.     ENDIF
  140.   UNTIL cancel! OR gotit!
  141. RETURN
  142. PROCEDURE play
  143.   GOSUB eachtime
  144.   '
  145.   OPENW #1
  146.   GOSUB makescene
  147.   OPENW #2
  148.   GOSUB makescene ! Same scene to both screen
  149.   '
  150.   GOSUB sprite
  151.   GOSUB movesprite
  152.   '
  153.   sit&=2
  154.   FRONTS sit&
  155.   GOSUB levelscan
  156.   IF NOT dead!
  157.     GOSUB fade(15) ! Fade front screen into view
  158.     GOSUB allfall
  159.     GOSUB swapscreen
  160.   ENDIF
  161.   '
  162.   DO UNTIL dead! OR gotit!
  163.     GOSUB input
  164.     GOSUB move
  165.   LOOP ! And now, number one, the idosyncratic loop...
  166.   '
  167.   IF dead!
  168.     GOSUB soundplay(2,63) ! Evil cackle
  169.   ENDIF
  170.   '
  171.   sit&=2
  172.   FRONTS sit&
  173.   GOSUB fade(0)
  174.   GOSUB nosprite
  175.   '
  176.   CLEARW #sit&
  177.   CLEARW #3-sit&
  178.   OPENW #sit&
  179.   IF gotit!
  180.     x$="Congratulations! You've"
  181.     GOSUB text((height&/2)-20,1)
  182.     x$="completed "+default$+"."
  183.     GOSUB text((height&/2),1)
  184.     IF LEFT$(next$,4)="END:"
  185.       x$="(The next password used to"
  186.       GOSUB text((height&/2)+70,1)
  187.       x$="edit "+default$+" is "+next$+")"
  188.       GOSUB text((height&/2)+90,1)
  189.       x$="You have finished this stream! Well done!"
  190.     ELSE
  191.       x$="The next password is "+next$+"."
  192.       IF next$<>"NONE"
  193.         autoload$=next$
  194.       ENDIF
  195.     ENDIF
  196.     GOSUB text((height&/2)+20,1)
  197.     IF menu&=1
  198.       default$=next$
  199.     ENDIF
  200.     GOSUB fade(15)
  201.     REPEAT ! Clear key buffer
  202.       PAUSE 1
  203.     UNTIL INKEY$=""
  204.     GOSUB pause
  205.     GOSUB fade(0)
  206.     CLEARW #sit&
  207.   ENDIF
  208. RETURN
  209. PROCEDURE edit
  210.   GOSUB selectlevel
  211.   IF brk!
  212.     x$="I can't find that one, do you want"
  213.     GOSUB text((height&/2)-32,1)
  214.     x$="to make a new level called "+type$+"?"
  215.     GOSUB text((height&/2)-22,1)
  216.     GOSUB yesno
  217.     GOSUB fade(0)
  218.     CLEARW #sit&
  219.     IF yesno&=2
  220.       GOTO ret
  221.     ENDIF
  222.     ARRAYFILL b&(),0
  223.     FOR f&=1 TO 30
  224.       b&(1,f&)=4
  225.       b&(20,f&)=4
  226.     NEXT f&
  227.     FOR g&=1 TO 20
  228.       b&(g&,1)=4
  229.       b&(g&,30)=4
  230.     NEXT g&
  231.     b&(2,2)=2
  232.     manx&=2
  233.     many&=2
  234.     default$=type$
  235.     map&=1
  236.     next$="NONE"
  237.     gravity&=1
  238.     author$="Unknown"
  239.     ARRAYFILL tele&(),0
  240.   ELSE
  241.     x$="Enter next Password for "+default$+":"
  242.     GOSUB text((height&/2)-12,1)
  243.     GOSUB fade(15)
  244.     PRINT AT(width&/16-3,height&/16+1);
  245.     IF debug!=TRUE
  246.       nexty$=next$
  247.     ELSE
  248.       FORM INPUT 8,nexty$
  249.     ENDIF
  250.     GOSUB fade(0)
  251.     CLEARW #sit&
  252.     IF UPPER$(nexty$)<>next$
  253.       x$="Sorry, you were wrong."
  254.       GOSUB text((height&/2)-10,1)
  255.       x$="Permission to edit level denied."
  256.       GOSUB text((height&/2)+10,1)
  257.       GOSUB fade(15)
  258.       GOSUB pause
  259.       GOSUB fade(0)
  260.       CLEARW #sit&
  261.       GOTO ret
  262.     ENDIF
  263.   ENDIF
  264.   GOSUB editlevel
  265. RETURN
  266. PROCEDURE saveopts
  267.   $U
  268.   OPEN "o",#1,"DEFAULT.LVL"
  269.   $U
  270.   FRONTS 2
  271.   PRINT #1;default$
  272.   PRINT #1;dispx&
  273.   PRINT #1;dispy&
  274.   PRINT #1;path$
  275.   PRINT #1;spritex&
  276.   PRINT #1;spritey&
  277.   CLOSE #1
  278. RETURN
  279. PROCEDURE quit
  280.   GOSUB soundquit
  281.   CLOSEW #1
  282.   CLOSEW #2
  283.   CLOSES 1
  284.   CLOSES 2
  285.   CLOSES 3
  286.   ~OpenWorkBench()
  287.   EDIT
  288. RETURN
  289. '
  290. PROCEDURE menu
  291.   IF autoload!
  292.     autoload!=FALSE
  293.     menu&=2
  294.     GOTO leaveproc
  295.   ENDIF
  296.   IF autoload$<>""
  297.     menu&=1
  298.     GOTO leaveproc
  299.   ENDIF
  300.   menu&=1
  301.   GOSUB menset
  302.   x$="Written by Francis Irving"
  303.   GOSUB text(height&/2+55,1)
  304.   x$="Graphics by Raymond Irving"
  305.   GOSUB text(height&/2+67,1)
  306.   PUT (width&-236)/2-2,20,title$
  307.   GOSUB fadetwo(15)
  308.   '
  309.   GOSUB mouse
  310.   oy&=height&-y&-40
  311.   REPEAT
  312.     joy&=STICK(1)
  313.     ink$=INKEY$
  314.     GOSUB mouse
  315.     omenu&=menu&
  316.     IF (y&<height&/2-20 AND oy&>=height&/2-20)
  317.       menu&=1
  318.     ENDIF
  319.     IF (y&>=height&/2-20 AND y&<height&/2+60 AND (oy&<height&/2-20 OR oy&=>height&/2+60))
  320.       menu&=2
  321.     ENDIF
  322.     IF (y&>=height&/2+60 AND oy&<height&/2+60)
  323.       menu&=4
  324.     ENDIF
  325.     IF joy&=1 OR ink$=CHR$(155)+CHR$(65)
  326.       DIV menu&,2
  327.     ENDIF
  328.     IF joy&=2 OR ink$=CHR$(155)+CHR$(66)
  329.       MUL menu&,2
  330.     ENDIF
  331.     IF menu&<1
  332.       menu&=1
  333.     ENDIF
  334.     IF menu&>4
  335.       menu&=4
  336.     ENDIF
  337.     IF menu&<>omenu&
  338.       GOSUB menset
  339.     ENDIF
  340.     IF joy&
  341.       REPEAT
  342.       UNTIL STICK(1)=0
  343.     ENDIF
  344.     oy&=y&
  345.   UNTIL b& OR ink$=CHR$(13) OR STRIG(1)
  346.   '
  347.   GOSUB fadetwo(0)
  348.   CLEARW #sit&
  349. RETURN
  350. PROCEDURE menset
  351.   x$="Play the Game"
  352.   GOSUB text((height&/2)-12,SGN(menu& AND 1)+8)
  353.   x$="Edit a Level"
  354.   GOSUB text((height&/2)+12,SGN(menu& AND 2)+8)
  355.   x$="Options Menu"
  356.   GOSUB text((height&/2)+104,SGN(menu& AND 4)+8)
  357. RETURN
  358. '
  359. PROCEDURE yesno
  360.   yesno&=1
  361.   GOSUB yesnoset
  362.   GOSUB fade(15)
  363.   '
  364.   GOSUB mouse
  365.   oy&=height&-y&-40
  366.   REPEAT
  367.     joy&=STICK(1)
  368.     ink$=INKEY$
  369.     GOSUB mouse
  370.     oyesno&=yesno&
  371.     IF (y&<height&/2-10 AND oy&>=height&/2-10) OR joy&=1 OR ink$=CHR$(155)+CHR$(65)
  372.       yesno&=1
  373.     ENDIF
  374.     IF (y&>=height&/2-10 AND oy&<height&/2-10) OR joy&=2 OR ink$=CHR$(155)+CHR$(66)
  375.       yesno&=2
  376.     ENDIF
  377.     IF yesno&<>oyesno&
  378.       GOSUB yesnoset
  379.     ENDIF
  380.     oy&=y&
  381.   UNTIL b& OR ink$=CHR$(13) OR STRIG(1)
  382.   '
  383.   GOSUB fade(0)
  384.   CLEARW #sit&
  385. RETURN
  386. PROCEDURE yesnoset
  387.   x$="Yes. Please."
  388.   GOSUB text((height&/2),(3-yesno&))
  389.   x$="No, Thanks."
  390.   GOSUB text((height&/2)+20,yesno&)
  391. RETURN
  392. '
  393. PROCEDURE options
  394.   menu&=1
  395.   GOSUB optset
  396.   x$="Version 3.0 - 2nd July 1994"
  397.   GOSUB text(height&/2-120,1)
  398.   GOSUB fadetwo(15)
  399.   '
  400.   GOSUB mouse
  401.   oy&=height&-y&-40
  402.   REPEAT
  403.     joy&=STICK(1)
  404.     ink$=INKEY$
  405.     GOSUB mouse
  406.     omenu&=menu&
  407.     IF (y&<height&/2-44 AND oy&>=height&/2-44)
  408.       menu&=1
  409.     ENDIF
  410.     IF (y&>=height&/2-44 AND y&<height&/2-20 AND (oy&<height&/2-44 OR oy&=>height&/2-20))
  411.       menu&=2
  412.     ENDIF
  413.     IF (y&>=height&/2-20 AND y&<height&/2+4 AND (oy&<height&/2-20 OR oy&=>height&/2+4))
  414.       menu&=4
  415.     ENDIF
  416.     IF (y&>=height&/2+4 AND y&<height&/2+28 AND (oy&<height&/2+4 OR oy&=>height&/2+28))
  417.       menu&=8
  418.     ENDIF
  419.     IF (y&>=height&/2+28 AND oy&<height&/2+28)
  420.       menu&=16
  421.     ENDIF
  422.     IF joy&=1 OR ink$=CHR$(155)+CHR$(65)
  423.       DIV menu&,2
  424.     ENDIF
  425.     IF joy&=2 OR ink$=CHR$(155)+CHR$(66)
  426.       MUL menu&,2
  427.     ENDIF
  428.     IF menu&<1
  429.       menu&=1
  430.     ENDIF
  431.     IF menu&>16
  432.       menu&=16
  433.     ENDIF
  434.     IF menu&<>omenu&
  435.       GOSUB optset
  436.     ENDIF
  437.     IF joy&
  438.       REPEAT
  439.       UNTIL STICK(1)=0
  440.     ENDIF
  441.     oy&=y&
  442.   UNTIL b& OR ink$=CHR$(13) OR STRIG(1)
  443.   '
  444.   GOSUB fadetwo(0)
  445.   CLEARW #sit&
  446. RETURN
  447. PROCEDURE optset
  448.   x$="Centre the Display"
  449.   GOSUB text((height&/2)-36,SGN(menu& AND 1)+8)
  450.   x$="Change Level Directory"
  451.   GOSUB text((height&/2)-12,SGN(menu& AND 2)+8)
  452.   x$="Quit the Game"
  453.   GOSUB text((height&/2)+12,SGN(menu& AND 4)+8)
  454.   x$="Save Options"
  455.   GOSUB text((height&/2)+36,SGN(menu& AND 8)+8)
  456.   x$="Return to Main Menu"
  457.   GOSUB text((height&/2)+104,SGN(menu& AND 16)+8)
  458. RETURN
  459. PROCEDURE opts
  460.   REPEAT
  461.     GOSUB options
  462.     SELECT menu&
  463.     CASE 1
  464.       GOSUB centre
  465.     CASE 2
  466.       GOSUB directory
  467.     CASE 4
  468.       GOSUB quit
  469.     CASE 8
  470.       GOSUB saveopts
  471.     ENDSELECT
  472.   UNTIL menu&=16
  473. RETURN
  474. PROCEDURE centre
  475.   x$="Centre the Display"
  476.   GOSUB text((height&/2)-40,1)
  477.   x$="Use the mouse. The large white"
  478.   GOSUB text((height&/2)-20,1)
  479.   x$="frame is the screen border."
  480.   GOSUB text((height&/2)+0,1)
  481.   x$="Click when finished."
  482.   GOSUB text((height&/2)+20,1)
  483.   COLOR 1
  484.   BOX 0,0,width&-1,height&-1
  485.   GOSUB fade(15)
  486.   GOSUB mouse
  487.   startx&=x&+dispx&+18
  488.   starty&=y&+dispy&+18
  489.   odispx&=dispx&
  490.   odispy&=dispy&
  491.   '
  492.   REPEAT
  493.     REPEAT
  494.       GOSUB mouse
  495.     UNTIL x&<>ox& OR y&<>oy& OR b&
  496.     dispx&=x&-(startx&-dispx&-18)+odispx&
  497.     dispy&=y&-(starty&-dispy&-18)+odispy&
  498.     IF dispy&<-29
  499.       dispy&=-29
  500.     ENDIF
  501.     GOSUB displaymove
  502.     ox&=x&
  503.     oy&=y&
  504.   UNTIL b&
  505.   REPEAT
  506.   UNTIL MOUSEK=0
  507.   GOSUB fade(0)
  508.   CLEARW #sit&
  509. RETURN
  510. PROCEDURE directory
  511.   REPEAT
  512.     x$="Enter Directory:"
  513.     GOSUB text((height&/2)-12,1)
  514.     x$="(Return for "+path$+")"
  515.     GOSUB text((height&/2)+16,1)
  516.     GOSUB fade(15)
  517.     '
  518.     PRINT AT(width&/16-15,height&/16+1);
  519.     oldpath$=path$
  520.     FORM INPUT 32,path$
  521.     GOSUB fade(0)
  522.     CLEARW #sit&
  523.     '
  524.     path$=UPPER$(path$)
  525.     IF path$=""
  526.       path$=oldpath$
  527.     ENDIF
  528.     '
  529.     nuke!=TRUE
  530.     IF NOT (EXIST(path$))
  531.       nuke!=FALSE
  532.       x$="I can't find that directory."
  533.       GOSUB text((height&/2)-10,1)
  534.       x$="Please try again."
  535.       GOSUB text((height&/2)+10,1)
  536.       GOSUB fade(15)
  537.       GOSUB pause
  538.       GOSUB fade(0)
  539.       CLEARW #sit&
  540.     ENDIF
  541.   UNTIL nuke!
  542. RETURN
  543. '
  544. ' Screen & Colour
  545. PROCEDURE openscreens
  546.   ~CloseWorkBench()
  547.   IF AvailMem(2)<105000
  548.     ~OpenWorkBench()
  549.     EDIT
  550.   ENDIF
  551.   OPENS 3,0,0,16,16,1,0 ! Don't ask (it's to do with O/S incompatibility (1.3 vs. 2.0))
  552.   width&=360
  553.   height&=280
  554.   FOR sit&=1 TO 2
  555.     OPENS sit&,0,0,width&,height&,4,16384 ! The last term for sprites
  556.     OPENW #sit&,0,0,width&,height&,0,4096+2048+65536+131072
  557.     TITLES #sit&,"Plasma Bubble Screen "+STR$(sit&)
  558.     TITLEW #sit&,""
  559.     CLEARW #sit&
  560.     IF sit&=1
  561.       GOSUB fullcolour
  562.     ELSE
  563.       GOSUB nocolour
  564.     ENDIF
  565.   NEXT sit&
  566.   CLEARW #1
  567.   CLEARW #2
  568.   sit&=2
  569. RETURN
  570. PROCEDURE displaymove
  571.   ' This lot moves the top-left coordinates of each screen up and
  572.   ' left a few pixels - So it's Panoramic!
  573.   FOR f&=1 TO 2
  574.     adr%=SCREEN(f&)+72 ! Find Viewport DX adress
  575.     DPOKE (adr%),dispx&
  576.     DPOKE (adr%+2),dispy&
  577.   NEXT f&
  578.   ~RemakeDisplay() ! Make this move show on the display
  579. RETURN
  580. PROCEDURE swapscreen
  581.   FRONTS sit&
  582.   sit&=3-sit&
  583.   OPENW #sit&
  584. RETURN
  585. PROCEDURE fullcolour
  586.   RESTORE col
  587.   FOR f&=0 TO 15
  588.     READ r&,g&,b&
  589.     SETCOLOR f&,r&,g&,b&
  590.   NEXT f&
  591.   SETCOLOR 22,15,15,15
  592.   SETCOLOR 26,15,15,15
  593. RETURN
  594. PROCEDURE nocolour
  595.   FOR f&=0 TO 15
  596.     SETCOLOR f&,0,0,0
  597.   NEXT f&
  598. RETURN
  599. PROCEDURE fade(dir&)
  600.   sit&=2
  601.   FRONTS sit&
  602.   FOR i=15-dir& TO dir& STEP SGN(dir&-7)
  603.     f=i/15
  604.     RESTORE col
  605.     FOR h&=0 TO 15
  606.       READ red&,green&,blue&
  607.       SETCOLOR h&,red&*f,green&*f,blue&*f
  608.     NEXT h&
  609.     SETCOLOR 22,15*f,15*f,15*f
  610.     SETCOLOR 26,15*f,15*f,15*f
  611.   NEXT i
  612. RETURN
  613. PROCEDURE fadetwo(dir&)
  614.   sit&=2
  615.   FRONTS sit&
  616.   FOR i=15-dir& TO dir& STEP SGN(dir&-7)
  617.     f=i/15
  618.     RESTORE coltwo
  619.     FOR h&=0 TO 15
  620.       READ red&,green&,blue&
  621.       SETCOLOR h&,red&*f,green&*f,blue&*f
  622.     NEXT h&
  623.   NEXT i
  624.   coltwo:
  625.   DATA 0,0,0, 13,13,13, 10,10,11, 8,8,7, 6,7,8, 8,6,7
  626.   DATA 4,4,4, 3,3,3, 15,15,15, 12,0,0, 0,0,0, 15,13,10
  627.   DATA 0,8,2, 0,15,15, 15,9,7, 15,15,15
  628. RETURN
  629. PROCEDURE colourdatum
  630.   col:
  631.   DATA 0,0,0, 15,15,15, 12,0,0, 5,14,5, 5,8,11, 2,12,12
  632.   DATA 13,14,0, 15,11,4, 9,9,9, 7,7,7, 9,15,2, 14,15,0
  633.   DATA 0,9,0, 6,10,11, 14,8,6, 13,13,13
  634. RETURN
  635. '
  636. ' Graphics
  637. PROCEDURE graphinit
  638.   graphfile$="PlasmaGraphics"
  639.   '
  640.   IF NOT (EXIST(graphfile$))
  641.     IF EXIST("PlasmaBubble:")
  642.       CHDIR "PlasmaBubble:"
  643.     ENDIF
  644.   ENDIF
  645.   '
  646.   IF NOT (EXIST(graphfile$))
  647.     x$="Unable to find the graphics file"
  648.     GOSUB text((height&/2)-30,1)
  649.     x$="called """+graphfile$+"""."
  650.     GOSUB text((height&/2)-10,1)
  651.     x$="CD to Plasma Bubble's directory"
  652.     GOSUB text((height&/2)+10,1)
  653.     x$="before running the game."
  654.     GOSUB text((height&/2)+30,1)
  655.     GOSUB fade(15)
  656.     GOSUB pause
  657.     GOSUB fade(0)
  658.     CLEARW #sit&
  659.     GOSUB quit
  660.   ELSE
  661.     GOSUB inlines
  662.   ENDIF
  663. RETURN
  664. PROCEDURE inlines
  665.   ' No longer inlines - the name is kept for prosterity.
  666.   ' We load the graphics now to save memory, so two copies
  667.   ' don't have to be kept at once.
  668.   ' 966 is the length of a 40 by 40 chunk of screen, when GETed
  669.   '
  670.   num&=50 ! Of shapes
  671.   '
  672.   OPEN "i",#1,graphfile$
  673.   FRONTS sit&
  674.   DIM a$(num&+10)
  675.   DIM mini$(num&+10)
  676.   DIM man$(4)
  677.   DIM egg$(7)
  678.   hatchy$=SPACE$(966)
  679.   DIM flappy$(4)
  680.   DIM fig$(9)
  681.   DIM exp$(6)
  682.   '
  683.   GET 0,0,39,39,a$(0)           ! Main graphics
  684.   FOR f&=1 TO num&+8
  685.     IF f&<>2 AND f&<>7 AND f&<>17 AND f&<>18 AND f&<>19 AND f&<>30 AND f&<>num&+1
  686.       a$(f&)=INPUT$(966,#1)
  687.     ENDIF
  688.   NEXT f&
  689.   '
  690.   FOR f&=1 TO num&+8           ! map/editor mini images
  691.     IF f&<>27 AND f&<>30 AND (f&<num&+2 OR f&>num&+8)
  692.       mini$(f&)=INPUT$(70,#1)
  693.     ENDIF
  694.   NEXT f&
  695.   GET 0,0,7,7,mini$(0)  ! nothing
  696.   COLOR 9
  697.   BOX 0,0,7,7
  698.   GET 0,0,7,7,mini$(30) ! editor invisible wall
  699.   DEFFILL 2
  700.   PBOX 0,0,7,7
  701.   COLOR 6
  702.   BOX 1,1,6,6
  703.   GET 0,0,7,7,mini$(27) ! map teleport
  704.   mini$(num&+2)=mini$(45)
  705.   mini$(num&+3)=mini$(46)
  706.   FOR f&=num&+4 TO num&+8
  707.     mini$(f&)=mini$(28)
  708.   NEXT f&
  709.   '
  710.   FOR f&=1 TO 4             ! player's four directions
  711.     man$(f&)=INPUT$(966,#1)
  712.   NEXT f&
  713.   '
  714.   FOR f&=1 TO 6             ! explosion animation
  715.     exp$(f&)=INPUT$(966,#1)
  716.   NEXT f&
  717.   '
  718.   FOR f&=1 TO 7             ! cracking egg
  719.     egg$(f&)=INPUT$(966,#1)
  720.   NEXT f&
  721.   '
  722.   hatchy$=INPUT$(966,#1)    ! hatchling's other wings
  723.   FOR f&=1 TO 4             ! and bouncy's other wings
  724.     flappy$(f&)=INPUT$(966,#1)
  725.   NEXT f&
  726.   '
  727.   FOR f&=0 TO 9             ! sprite numbers for diamond count
  728.     fig$(f&)=INPUT$(88,#1)
  729.     dummy$=INPUT$(8,#1) ! we don't want the bottom bit
  730.   NEXT f&
  731.   '
  732.   title$=INPUT$(9606,#1)    ! logo
  733.   CLOSE #1
  734.   '
  735.   a$(2)=man$(4)       ! Fill the rest of the main graphics in: first yourself
  736.   a$(7)=a$(3)         ! Falling diamond
  737.   a$(17)=a$(4)        ! Pushy wall
  738.   a$(18)=a$(2)        ! Manikin
  739.   a$(19)=egg$(1)      ! Cracking egg (waiting)
  740.   a$(30)=a$(0)        ! Invisible wall
  741.   a$(num&+1)=egg$(1)  ! Actual cracking egg
  742. RETURN
  743. PROCEDURE makescene
  744.   FOR f&=manx&-4 TO manx&+4
  745.     FOR g&=many&-3 TO many&+3
  746.       px&=(f&-manx&+4)*40
  747.       py&=(g&-many&+3)*40
  748.       IF f&>0 AND f&<31 AND g&>0 AND g&<21
  749.         PUT px&,py&,a$(b&(g&,f&))
  750.         map!(g&,f&)=TRUE
  751.       ELSE
  752.         PUT px&,py&,a$(0)
  753.       ENDIF
  754.     NEXT g&
  755.   NEXT f&
  756. RETURN
  757. PROCEDURE move
  758.   IF b&(many&,manx&)<>2
  759.     GOTO ret
  760.   ENDIF
  761.   '
  762.   SELECT joy& ! Pump new man grapics into place
  763.   CASE 1
  764.     a$(2)=man$(3)
  765.   CASE 8
  766.     a$(2)=man$(2)
  767.   CASE 2
  768.     a$(2)=man$(4)
  769.   CASE 4
  770.     a$(2)=man$(1)
  771.   ENDSELECT
  772.   '
  773.   IF dmanx&<>0 AND dmanx&=-odmanx& ! smoother rotation of you between opposite directions
  774.     PUT 160,120,man$(RANDOM(2)+3)
  775.     GOSUB swapscreen
  776.     PAUSE 3
  777.   ENDIF
  778.   IF dmany&<>0 AND dmany&=-odmany&
  779.     PUT 160,120,man$(RANDOM(2)+1)
  780.     GOSUB swapscreen
  781.     PAUSE 3
  782.   ENDIF
  783.   PUT 160,120,a$(2) ! Initial rotation
  784.   GOSUB swapscreen
  785.   '
  786.   ' Scroll!
  787.   b&(many&,manx&)=0
  788.   ADD many&,dmany&
  789.   ADD manx&,dmanx&
  790.   IF s!(b&(many&,manx&),8)
  791.     INC score&
  792.     '    SOUND 2092.8,1,255,0
  793.     IF score&=needed&
  794.       gotit!=TRUE
  795.     ENDIF
  796.     GOSUB sprite
  797.   ENDIF
  798.   tele!=FALSE
  799.   IF b&(many&,manx&)=27
  800.     tele!=TRUE
  801.   ENDIF
  802.   b&(many&,manx&)=2
  803.   IF dmanx&<>0
  804.     f&=manx&+4
  805.     IF dmanx&=-1
  806.       f&=manx&-4
  807.     ENDIF
  808.     FOR h&=1 TO 2
  809.       SCROLL -40*dmanx&,0,0,0,width&,height&
  810.       FOR g&=many&-3 TO many&+3
  811.         px&=(f&-manx&+4)*40
  812.         py&=(g&-many&+3)*40
  813.         IF f&>0 AND f&<31 AND g&>0 AND g&<21
  814.           PUT px&,py&,a$(b&(g&,f&))
  815.           map!(g&,f&)=TRUE
  816.         ENDIF
  817.       NEXT g&
  818.       PUT 160,120,a$(2)
  819.       GOSUB put(many&-dmany&,manx&-dmanx&)
  820.       IF push!
  821.         GOSUB put(many&+dmany&,manx&+dmanx&)
  822.       ENDIF
  823.       IF h&=1
  824.         IF monster!
  825.           GOSUB monsters
  826.         ENDIF
  827.         GOSUB swapscreen
  828.       ENDIF
  829.     NEXT h&
  830.     IF monster!
  831.       GOSUB monother
  832.     ENDIF
  833.   ENDIF
  834.   IF dmany&<>0
  835.     g&=many&+3
  836.     IF dmany&=-1
  837.       g&=many&-3
  838.     ENDIF
  839.     FOR h&=1 TO 2
  840.       SCROLL 0,-40*dmany&,0,0,width&,height&
  841.       FOR f&=manx&-4 TO manx&+4
  842.         px&=(f&-manx&+4)*40
  843.         py&=(g&-many&+3)*40
  844.         IF f&>0 AND f&<31 AND g&>0 AND g&<21
  845.           PUT px&,py&,a$(b&(g&,f&))
  846.           map!(g&,f&)=TRUE
  847.         ENDIF
  848.       NEXT f&
  849.       PUT 160,120,a$(2)
  850.       GOSUB put(many&-dmany&,manx&-dmanx&)
  851.       IF push!
  852.         GOSUB put(many&+dmany&,manx&+dmanx&)
  853.       ENDIF
  854.       IF h&=1
  855.         IF monster!
  856.           GOSUB monsters
  857.         ENDIF
  858.         GOSUB swapscreen
  859.       ENDIF
  860.     NEXT h&
  861.     IF monster!
  862.       GOSUB monother
  863.     ENDIF
  864.   ENDIF
  865.   '
  866.   IF monster!
  867.     GOSUB monfall
  868.   ENDIF
  869.   '
  870.   IF tele!
  871.     GOSUB teleport
  872.   ENDIF
  873.   '
  874.   IF bang!
  875.     GOSUB explode(many&+dmany&,manx&+dmanx&)
  876.   ENDIF
  877.   IF NOT tele!
  878.     GOSUB check(many&-dmany&,manx&-dmanx&)
  879.   ENDIF
  880.   GOSUB check(many&,manx&)
  881.   '
  882.   odmanx&=dmanx&
  883.   odmany&=dmany&
  884.   IF dead! AND prin!
  885.     IF b&(many&,manx&)=2
  886.       b&(many&,manx&)=0
  887.       GOSUB explode(many&,manx&)
  888.     ENDIF
  889.   ENDIF
  890.   IF push!
  891.     IF s!(b&(many&+dmany&,manx&+dmanx&),1)
  892.       GOSUB fallch(many&+dmany&,manx&+dmanx&)
  893.     ENDIF
  894.     GOSUB check(many&+dmany&,manx&+dmanx&)
  895.   ENDIF
  896. RETURN
  897. PROCEDURE text(vert&,col&)
  898.   COLOR col&
  899.   TEXT (width&-LEN(x$)*8)/2,vert&,x$
  900. RETURN
  901. PROCEDURE put(yy&,xx&)
  902.   LOCAL x&,y&
  903.   x&=xx&
  904.   y&=yy&
  905.   px&=x&-manx&+4
  906.   py&=y&-many&+3
  907.   IF px&=>0 AND py&=>0 AND px&<9 AND py&<7
  908.     PUT px&*40,py&*40,a$(b&(y&,x&))
  909.     onscr!=TRUE
  910.   ENDIF
  911. RETURN
  912. PROCEDURE explode(yy&,xx&)
  913.   LOCAL x&,y&
  914.   x&=xx&
  915.   y&=yy&
  916.   px&=x&-manx&+4
  917.   py&=y&-many&+3
  918.   IF px&=>0 AND py&=>0 AND px&<9 AND py&<7
  919.     '    GOSUB soundplay(1,63) ! Explode noise
  920.     FOR f&=1 TO 6
  921.       PUT px&*40,py&*40,exp$(f&)
  922.       GOSUB swapscreen
  923.       PAUSE 2
  924.     NEXT f&
  925.     PUT px&*40,py&*40,a$(b&(y&,x&))
  926.     GOSUB swapscreen
  927.     PUT px&*40,py&*40,a$(b&(y&,x&))
  928.   ENDIF
  929. RETURN
  930. PROCEDURE map
  931.   GOSUB swapscreen
  932.   OPENW #2
  933.   FRONTS 2
  934.   GRAPHMODE 0
  935.   temp$=mini$(7)
  936.   mini$(7)=mini$(3) ! Falling diamonds look normal
  937.   temp2$=mini$(17)
  938.   mini$(17)=mini$(4)! Pushable walls are indistinguishable
  939.   temp3$=mini$(30)
  940.   mini$(30)=mini$(0)! Invisible walls are, er., invisible
  941.   x$=default$+" by "+author$
  942.   GOSUB text(17,1)
  943.   x$="Diamonds Needed: "+STR$(needed&-score&)
  944.   GOSUB nosprite
  945.   GOSUB text(37,1)
  946.   x$="Initial Pushable Walls: "+STR$(pushywall&)
  947.   GOSUB text(54,1)
  948.   IF map&<>0
  949.     x$="Press P for a Printout"
  950.     GOSUB text(250,1)
  951.   ENDIF
  952.   IF map&>0
  953.     DEFFILL 0
  954.     PBOX 8+(width&/2)-127,8+(height&/2)-84,31*8-1+(width&/2)-127,21*8-1+(height&/2)-84
  955.     DEFFILL 3
  956.     BOX 7+(width&/2)-127,7+(height&/2)-84,31*8+(width&/2)-127,21*8+(height&/2)-84
  957.     FOR y&=1 TO 10
  958.       FOR x&=1 TO 15
  959.         GOSUB mapx(y&,x&)
  960.         GOSUB mapx(21-y&,x&)
  961.         GOSUB mapx(y&,31-x&)
  962.         GOSUB mapx(21-y&,31-x&)
  963.       NEXT x&
  964.     NEXT y&
  965.   ELSE
  966.     x$="No map on this level."
  967.     GOSUB text(width&/2+4,1)
  968.   ENDIF
  969.   mini$(7)=temp$
  970.   mini$(17)=temp2$
  971.   mini$(30)=temp3$
  972.   rewait:
  973.   GRAPHMODE 1
  974.   GOSUB pause
  975.   IF map&<>0 AND UPPER$(ink$)="P"
  976.     DEFFILL 0
  977.     PBOX 0,0,width&,8+(height&/2)-84
  978.     PBOX 0,0,8+(width&/2)-127,height&
  979.     PBOX 31*8-1+(width&/2)-127,0,width&,height&
  980.     PBOX 0,21*8-1+(height&/2)-84,width&,height&
  981.     x$=default$+" by "+author$
  982.     GOSUB text(17,1)
  983.     x$="Diamonds Needed: "+STR$(needed&-score&)
  984.     GOSUB nosprite
  985.     GOSUB text(37,1)
  986.     x$="Initial Pushable Walls: "+STR$(pushywall&)
  987.     GOSUB text(54,1)
  988.     SETCOLOR 1,0,0,0
  989.     SETCOLOR 0,15,15,15
  990.     HARDCOPY
  991.     PRINT "Done hardcopy"
  992.     GOSUB fullcolour
  993.   ENDIF
  994.   GOSUB sprite
  995.   GOSUB movesprite
  996.   FRONTS 1
  997.   GOSUB makescene
  998.   GOSUB swapscreen
  999. RETURN
  1000. PROCEDURE mapx(f&,g&)
  1001.   IF b&(f&,g&)<>0 AND (map!(f&,g&) OR map&=1)
  1002.     PUT g&*8+(width&/2)-127,f&*8+(height&/2)-84,mini$(b&(f&,g&))
  1003.   ENDIF
  1004. RETURN
  1005. PROCEDURE teleport
  1006.   beforemanx&=manx&
  1007.   beforemany&=many&
  1008.   FRONTS 2
  1009.   FOR h&=1 TO 26
  1010.     IF (many&=tele&(h&,1) AND manx&=tele&(h&,2))
  1011.       many&=tele&(h&,3)
  1012.       manx&=tele&(h&,4)
  1013.       EXIT IF 1
  1014.     ELSE IF (many&=tele&(h&,3) AND manx&=tele&(h&,4))
  1015.       many&=tele&(h&,1)
  1016.       manx&=tele&(h&,2)
  1017.       EXIT IF 1
  1018.     ENDIF
  1019.   NEXT h&
  1020.   IF manx&=0 AND many&=0 ! If only one teleport of that type
  1021.     dead!=TRUE           ! then your journey is fatal.
  1022.     prin!=TRUE
  1023.     manx&=beforemanx&
  1024.     many&=beforemany&
  1025.   ELSE ! Teleport them
  1026.     b&(many&,manx&)=b&(beforemany&,beforemanx&) ! Just in case nothing is being ported
  1027.     b&(beforemany&,beforemanx&)=0
  1028.     '
  1029.     mul&=(RANDOM(2)*2)-1
  1030.     FOR ff&=1 TO 9
  1031.       ADD dispx&,mul&*(ff&^2)
  1032.       GOSUB displaymove
  1033.     NEXT ff&
  1034.     GOSUB nocolour
  1035.     '
  1036.     OPENW #2
  1037.     GOSUB makescene
  1038.     OPENW #1
  1039.     GOSUB makescene
  1040.     '
  1041.     GOSUB fullcolour
  1042.     FOR ff&=9 DOWNTO 1
  1043.       SUB dispx&,mul&*(ff&^2)
  1044.       GOSUB displaymove
  1045.     NEXT ff&
  1046.     '
  1047.     GOSUB swapscreen
  1048.     GOSUB check(beforemany&,beforemanx&)
  1049.     GOSUB check(beforemany&-dmany&,beforemanx&-dmanx&)
  1050.   ENDIF
  1051. RETURN
  1052. '
  1053. PROCEDURE sprite
  1054.   sprite!=TRUE
  1055.   fig$="   "
  1056.   RSET fig$=STR$(ABS(needed&-score&))
  1057.   FOR spr&=1 TO 3
  1058.     IF MID$(fig$,spr&,1)>="0" AND MID$(fig$,spr&,1)<=":"
  1059.       SPRITE #spr&+1,fig$(ASC(MID$(fig$,spr&,1))-48)
  1060.     ELSE
  1061.       SPRITE #spr&+1,fig$(0)
  1062.     ENDIF
  1063.   NEXT spr&
  1064. RETURN
  1065. PROCEDURE nosprite
  1066.   IF sprite!
  1067.     sprite!=FALSE
  1068.     SPRITE #2
  1069.     SPRITE #3
  1070.     SPRITE #4
  1071.   ENDIF
  1072. RETURN
  1073. PROCEDURE movesprite
  1074.   IF sprite!
  1075.     FOR spr&=1 TO 3
  1076.       SPRITE #spr&+1,spritex&+spr&*16,spritey&
  1077.     NEXT spr&
  1078.   ENDIF
  1079. RETURN
  1080. '
  1081. ' Input
  1082. PROCEDURE pause
  1083.   REPEAT
  1084.     ink$=INKEY$
  1085.   UNTIL ink$<>"" OR MOUSEK OR STRIG(1)
  1086. RETURN
  1087. PROCEDURE input
  1088.   t=TIMER
  1089.   trol=TIMER
  1090.   REPEAT
  1091.     REPEAT
  1092.       ink$=INKEY$
  1093.     UNTIL ink$<>oink$ OR ink$=""! Clear the keyboard buffer
  1094.     joy&=0
  1095.     b&=0
  1096.     WHILE joy&=0 AND ink$="" AND b&<>1 AND NOT dead!
  1097.       IF monster!
  1098.         IF TIMER>t+50
  1099.           GOSUB monsters
  1100.           GOSUB swapscreen
  1101.           GOSUB monother
  1102.           GOSUB monfall
  1103.           t=TIMER
  1104.         ENDIF
  1105.       ENDIF
  1106.       IF TIMER>trol+800 AND odmany&<>1
  1107.         IF odmany&=-1
  1108.           PUT 160,120,man$(RANDOM(2)+1)
  1109.           GOSUB swapscreen
  1110.           PAUSE 3
  1111.         ENDIF
  1112.         a$(2)=man$(4)
  1113.         GOSUB put(many&,manx&)
  1114.         GOSUB swapscreen
  1115.         GOSUB put(many&,manx&)
  1116.         GOSUB swapscreen
  1117.         odmanx&=0
  1118.         odmany&=1
  1119.       ENDIF
  1120.       joy&=STICK(1)
  1121.       IF STRIG(1)
  1122.         joy&=16
  1123.       ENDIF
  1124.       ink$=UPPER$(INKEY$)
  1125.       GOSUB mouse
  1126.       '
  1127.       IF (x&<>oldx& OR y&<>oldy&) AND b&=2
  1128.         oldx&=x&
  1129.         oldy&=y&
  1130.         SUB x&,22-dispx&
  1131.         ADD y&,8
  1132.         LET spritex&=x&
  1133.         LET spritey&=y&
  1134.         FRONTS 2
  1135.         GOSUB movesprite
  1136.       ENDIF
  1137.       '
  1138.       IF ink$="P" OR ink$=" "
  1139.         trolalol=t-TIMER
  1140.         trolalolalol=trol-TIMER
  1141.         GRAPHMODE 0
  1142.         x$="Game Paused"
  1143.         GOSUB text(height&/2,1)
  1144.         GRAPHMODE 1
  1145.         GOSUB swapscreen
  1146.         GOSUB pause
  1147.         GOSUB swapscreen
  1148.         GOSUB makescene
  1149.         t=TIMER+trolalol
  1150.         trol=TIMER+trolalolalol
  1151.         ink$=""
  1152.       ENDIF
  1153.     WEND
  1154.     dmanx&=0
  1155.     dmany&=0
  1156.     IF LEFT$(ink$,1)=CHR$(155)
  1157.       SELECT RIGHT$(ink$,1) ! Detect cursors
  1158.       CASE "A"
  1159.         joy&=1
  1160.       CASE "B"
  1161.         joy&=2
  1162.       CASE "C"
  1163.         joy&=8
  1164.       CASE "D"
  1165.         joy&=4
  1166.       ENDSELECT
  1167.     ENDIF
  1168.     oink$=ink$
  1169.     IF ink$=CHR$(27) ! Escape?
  1170.       dead!=TRUE
  1171.       prin!=TRUE
  1172.     ENDIF
  1173.     push!=FALSE
  1174.     bang!=FALSE
  1175.     EXIT IF dead!
  1176.     IF ink$=CHR$(155)+CHR$(63)+CHR$(126) OR UPPER$(ink$)="M" OR b&=1 OR joy&=16 OR ink$=CHR$(13) ! Help, M, Click, Fire, Return
  1177.       GOSUB map
  1178.       trol=TIMER
  1179.     ENDIF
  1180.     SELECT joy& ! Set Delta X and Delta Y as per Joy&
  1181.     CASE 1
  1182.       DEC dmany&
  1183.     CASE 8
  1184.       INC dmanx&
  1185.     CASE 2
  1186.       INC dmany&
  1187.     CASE 4
  1188.       DEC dmanx&
  1189.     ENDSELECT
  1190.     IF s!(b&(many&+dmany&,manx&+dmanx&),7) ! Pushable?
  1191.       IF (s!(b&(many&+dmany&*2,manx&+dmanx&*2),4) AND b&(many&+dmany&,manx&+dmanx&)<>28) OR (b&(many&+dmany&,manx&+dmanx&)=28 AND s!(b&(many&+dmany&*2,manx&+dmanx&*2),10))! Pushthroughable?
  1192.         push!=TRUE
  1193.         IF s!(b&(many&+dmany&*2,manx&+dmanx&*2),3)
  1194.           bang!=TRUE
  1195.           b&(many&+dmany&*2,manx&+dmanx&*2)=0
  1196.         ELSE
  1197.           b&(many&+dmany&*2,manx&+dmanx&*2)=b&(many&+dmany&,manx&+dmanx&)
  1198.           IF b&(many&+dmany&,manx&+dmanx&)=19 OR b&(many&+dmany&,manx&+dmanx&)=10 OR b&(many&+dmany&,manx&+dmanx&)=num&+1
  1199.             FOR i&=1 TO maxmon&
  1200.               IF egg&(i&,3)<>3 AND many&+dmany&=egg&(i&,1) AND manx&+dmanx&=egg&(i&,2)
  1201.                 ADD egg&(i&,1),dmany&
  1202.                 ADD egg&(i&,2),dmanx&
  1203.               ENDIF
  1204.             NEXT i&
  1205.           ENDIF
  1206.         ENDIF
  1207.         b&(many&+dmany&,manx&+dmanx&)=0
  1208.       ENDIF
  1209.     ENDIF
  1210.     IF b&(many&+dmany&,manx&+dmanx&)=45 AND dmanx&=-1 ! Set off bubble
  1211.       IF odmanx&=1
  1212.         PUT 160,120,man$(RANDOM(2)+3)
  1213.         GOSUB swapscreen
  1214.         PAUSE 3
  1215.       ENDIF
  1216.       a$(2)=man$(1)
  1217.       GOSUB startbubmac(many&+dmany&,manx&+dmanx&)
  1218.       GOSUB put(many&+dmany&,manx&+dmanx&)
  1219.       GOSUB put(many&+dmany&-1,manx&+dmanx&)
  1220.       GOSUB put(many&,manx&)
  1221.       GOSUB swapscreen
  1222.       GOSUB put(many&+dmany&,manx&+dmanx&)
  1223.       GOSUB put(many&+dmany&-1,manx&+dmanx&)
  1224.       GOSUB put(many&,manx&)
  1225.       GOSUB swapscreen
  1226.       odmanx&=-1
  1227.       odmany&=0
  1228.       t=TIMER
  1229.       trol=TIMER
  1230.     ENDIF
  1231.     IF b&(many&+dmany&,manx&+dmanx&)=46 AND dmanx&=1
  1232.       IF odmanx&=-1
  1233.         PUT 160,120,man$(RANDOM(2)+3)
  1234.         GOSUB swapscreen
  1235.         PAUSE 3
  1236.       ENDIF
  1237.       a$(2)=man$(2)
  1238.       GOSUB startbubmac(many&+dmany&,manx&+dmanx&)
  1239.       GOSUB put(many&+dmany&,manx&+dmanx&)
  1240.       GOSUB put(many&+dmany&-1,manx&+dmanx&)
  1241.       GOSUB put(many&,manx&)
  1242.       GOSUB swapscreen
  1243.       GOSUB put(many&+dmany&,manx&+dmanx&)
  1244.       GOSUB put(many&+dmany&-1,manx&+dmanx&)
  1245.       GOSUB put(many&,manx&)
  1246.       GOSUB swapscreen
  1247.       odmanx&=1
  1248.       odmany&=0
  1249.       t=TIMER
  1250.       trol=TIMER
  1251.     ENDIF
  1252.   UNTIL s!(b&(many&+dmany&,manx&+dmanx&),2) OR push! ! Can they move thataway?
  1253.   IF s!(b&(many&+dmany&,manx&+dmanx&),3)
  1254.     dead!=TRUE
  1255.     prin!=TRUE
  1256.   ENDIF
  1257. RETURN
  1258. PROCEDURE mouse
  1259.   y%=DPEEK(SCREEN(3)+16) ! Don't ask
  1260.   x%=DPEEK(SCREEN(3)+18)
  1261.   b&=MOUSEK
  1262.   IF x%>32767
  1263.     x%=0
  1264.   ENDIF
  1265.   IF y%>32767
  1266.     y%=0
  1267.   ENDIF
  1268.   x&=x%
  1269.   y&=y%
  1270.   SUB x&,dispx&+18
  1271.   SUB y&,dispy&+18
  1272. RETURN
  1273. '
  1274. ' Boulder/Monster Calculations
  1275. PROCEDURE makeegg
  1276.   FOR i&=1 TO maxmon&
  1277.     IF egg&(i&,3)=3
  1278.       monster!=TRUE
  1279.       egg&(i&,1)=e&
  1280.       egg&(i&,2)=t&
  1281.       IF crack!
  1282.         egg&(i&,3)=0
  1283.         egg&(i&,4)=1
  1284.         b&(e&,t&)=num&+1
  1285.       ELSE
  1286.         egg&(i&,3)=1
  1287.         egg&(i&,4)=1
  1288.         crack!=TRUE
  1289.         b&(e&,t&)=19
  1290.         a$(19)=egg$(1)
  1291.       ENDIF
  1292.       EXIT IF 1
  1293.     ENDIF
  1294.   NEXT i&
  1295.   IF i&=maxmon&+1
  1296.     b&(e&,t&)=10
  1297.   ENDIF
  1298.   GOSUB put(e&,t&) ! ***
  1299.   GOSUB swapscreen
  1300.   GOSUB put(e&,t&)
  1301. RETURN
  1302. PROCEDURE makehatchy
  1303.   FOR i&=1 TO maxmon&
  1304.     IF egg&(i&,3)=3
  1305.       monster!=TRUE
  1306.       egg&(i&,1)=e&
  1307.       egg&(i&,2)=t&
  1308.       '
  1309.       egg&(i&,3)=2
  1310.       egg&(i&,4)=1
  1311.       '
  1312.       egg&(i&,9)=0
  1313.       '
  1314.       GOSUB put(e&,t&)
  1315.       GOSUB swapscreen ! ***
  1316.       GOSUB put(e&,t&)
  1317.       EXIT IF 1
  1318.     ENDIF
  1319.   NEXT i&
  1320. RETURN
  1321. PROCEDURE makebouncy
  1322.   FOR i&=1 TO maxmon&
  1323.     IF egg&(i&,3)=3
  1324.       monster!=TRUE
  1325.       egg&(i&,1)=e&
  1326.       egg&(i&,2)=t&
  1327.       egg&(i&,3)=5
  1328.       egg&(i&,11)=0
  1329.       egg&(i&,9)=0
  1330.       GOSUB put(e&,t&)
  1331.       GOSUB swapscreen ! ***
  1332.       GOSUB put(e&,t&)
  1333.       EXIT IF 1
  1334.     ENDIF
  1335.   NEXT i&
  1336. RETURN
  1337. PROCEDURE swaphatch
  1338.   SWAP hatchy$,a$(20)
  1339.   FOR hf&=1 TO 4
  1340.     dummy$=a$(40+hf&)
  1341.     a$(40+hf&)=flappy$(hf&)
  1342.     flappy$(hf&)=dummy$
  1343.   NEXT hf&
  1344. RETURN
  1345. PROCEDURE monsters
  1346.   GOSUB swaphatch
  1347.   count&=0
  1348.   FOR j&=1 TO maxmon&
  1349.     begg&=b&(egg&(j&,1),egg&(j&,2))
  1350.     IF (egg&(j&,3)=0 AND begg&<>num&+1) OR (egg&(j&,3)=1 AND begg&<>19) OR (egg&(j&,3)=2 AND begg&<>20 AND begg&<>31) OR (egg&(j&,3)=4 AND begg&<>21 AND begg&<>22 AND begg&<>31) OR (egg&(j&,3)=5 AND (begg&<41 OR begg&>44) AND begg&<>31) ! it's dead
  1351.       IF egg&(j&,3)=1
  1352.         crack!=FALSE
  1353.       ENDIF
  1354.       egg&(j&,3)=3
  1355.     ENDIF
  1356.     IF (egg&(j&,3)=7 AND (begg&<47 OR begg&>50) AND begg&<>31) ! death-check IF cont.
  1357.       egg&(j&,3)=3
  1358.     ENDIF
  1359.     IF egg&(j&,3)<>3
  1360.       INC count&
  1361.     ENDIF
  1362.     IF egg&(j&,3)=2
  1363.       IF begg&<>31
  1364.         dy&=0
  1365.         dx&=0
  1366.         IF manx&>egg&(j&,2)
  1367.           dx&=1
  1368.         ENDIF
  1369.         IF manx&<egg&(j&,2)
  1370.           dx&=-1
  1371.         ENDIF
  1372.         gointo&=b&(egg&(j&,1),egg&(j&,2)+dx&)
  1373.         IF gointo&=0 OR gointo&=31
  1374.           GOTO moveit
  1375.         ENDIF
  1376.         dx&=0
  1377.         IF many&>egg&(j&,1)
  1378.           dy&=1
  1379.         ENDIF
  1380.         IF many&<egg&(j&,1)
  1381.           dy&=-1
  1382.         ENDIF
  1383.         gointo&=b&(egg&(j&,1)+dy&,egg&(j&,2))
  1384.         IF gointo&=0
  1385.           GOTO moveit
  1386.         ENDIF
  1387.         GOTO nocanmove
  1388.         moveit:
  1389.         IF gointo&=0
  1390.           SWAP b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&),b&(egg&(j&,1),egg&(j&,2))
  1391.         ELSE IF gointo&=31
  1392.           b&(egg&(j&,1),egg&(j&,2))=0 ! gone into monsterport
  1393.           egg&(j&,9)=dx&
  1394.         ENDIF
  1395.         egg&(j&,5)=egg&(j&,1)
  1396.         egg&(j&,6)=egg&(j&,2)
  1397.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1398.         ADD egg&(j&,1),dy&
  1399.         ADD egg&(j&,2),dx&
  1400.         IF gointo&=31
  1401.           GOSUB monsterport
  1402.         ENDIF
  1403.         nocanmove:
  1404.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1405.         endit:
  1406.       ELSE
  1407.         dx&=egg&(j&,9)
  1408.         IF b&(egg&(j&,1),egg&(j&,2)+dx&)=0 ! left monsterport
  1409.           egg&(j&,5)=egg&(j&,1)
  1410.           egg&(j&,6)=egg&(j&,2)
  1411.           b&(egg&(j&,1),egg&(j&,2)+dx&)=20 ! put creature back
  1412.           GOSUB put(egg&(j&,1),egg&(j&,2))
  1413.           ADD egg&(j&,2),dx&
  1414.           GOSUB put(egg&(j&,1),egg&(j&,2))
  1415.         ELSE IF b&(egg&(j&,1),egg&(j&,2)+dx&)=31
  1416.           egg&(j&,5)=egg&(j&,1)
  1417.           egg&(j&,6)=egg&(j&,2)
  1418.           ADD egg&(j&,2),dx&
  1419.           GOSUB monsterport
  1420.         ELSE
  1421.           egg&(j&,5)=egg&(j&,1)
  1422.           egg&(j&,6)=egg&(j&,2)
  1423.           egg&(j&,9)=-egg&(j&,9)
  1424.           dx&=-dx&
  1425.           GOSUB monsterport
  1426.         ENDIF
  1427.       ENDIF
  1428.     ENDIF
  1429.     IF egg&(j&,3)=1
  1430.       INC egg&(j&,4)
  1431.       IF egg&(j&,4)=8
  1432.         INC egg&(j&,3)
  1433.         INC b&(egg&(j&,1),egg&(j&,2))
  1434.         crack!=FALSE
  1435.         egg&(j&,7)=1
  1436.       ELSE
  1437.         a$(19)=egg$(egg&(j&,4))
  1438.       ENDIF
  1439.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1440.     ENDIF
  1441.     IF egg&(j&,3)=0 AND crack!=FALSE
  1442.       egg&(j&,3)=1
  1443.       egg&(j&,4)=1
  1444.       crack!=TRUE
  1445.       b&(egg&(j&,1),egg&(j&,2))=19
  1446.       a$(19)=egg$(1)
  1447.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1448.     ENDIF
  1449.     IF egg&(j&,3)=4 OR egg&(j&,3)=5 ! Lefty/Righty OR Bouncy
  1450.       dy&=0
  1451.       dx&=0
  1452.       IF begg&=22 OR begg&=44
  1453.         dx&=1
  1454.       ENDIF
  1455.       IF begg&=21 OR begg&=42
  1456.         dx&=-1
  1457.       ENDIF
  1458.       IF begg&=41
  1459.         dy&=-1
  1460.       ENDIF
  1461.       IF begg&=43
  1462.         dy&=1
  1463.       ENDIF
  1464.       IF begg&=31
  1465.         dx&=egg&(j&,9)
  1466.         dy&=0
  1467.       ENDIF
  1468.       push2!=FALSE
  1469.       IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=2 OR b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=18 ! killed you or manikin
  1470.         mainky&=100
  1471.         manikx&=100
  1472.         IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=18
  1473.           maniky&=egg&(j&,1)+dy&
  1474.           manikx&=egg&(j&,2)+dx&
  1475.         ENDIF
  1476.         b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=2
  1477.         IF begg&<>31
  1478.           b&(egg&(j&,1),egg&(j&,2))=0
  1479.         ENDIF
  1480.         egg&(j&,5)=egg&(j&,1)
  1481.         egg&(j&,6)=egg&(j&,2)
  1482.         dead!=TRUE
  1483.         GOTO jud
  1484.       ENDIF
  1485.       IF s!(b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&),7) ! Pushable?
  1486.         IF (s!(b&(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2),4) AND b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)<>28) OR (b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=28 AND s!(b&(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2),10))! Pushthroughable?
  1487.           egg&(j&,11)=dx&
  1488.           egg&(j&,12)=dy&
  1489.           IF s!(b&(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2),3)
  1490.             egg&(j&,11)=dx&*2
  1491.             egg&(j&,12)=dy&*2
  1492.             b&(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2)=0
  1493.           ELSE
  1494.             b&(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2)=b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)
  1495.             IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=19 OR b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=10 OR b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=num&+1
  1496.               FOR i&=1 TO maxmon&
  1497.                 IF egg&(i&,3)<>3 AND egg&(j&,1)+dy&=egg&(i&,1) AND egg&(j&,2)+dx&=egg&(i&,2)
  1498.                   ADD egg&(i&,2),dx&
  1499.                   ADD egg&(i&,1),dy&
  1500.                 ENDIF
  1501.               NEXT i&
  1502.             ENDIF
  1503.           ENDIF
  1504.           b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=0
  1505.           GOSUB put(egg&(j&,1)+dy&*2,egg&(j&,2)+dx&*2)
  1506.           push2!=TRUE
  1507.         ENDIF
  1508.       ENDIF
  1509.       IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=0 OR push2!
  1510.         IF begg&=31
  1511.           IF egg&(j&,3)=4 !lefty/righty
  1512.             b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=(egg&(j&,9)+1)/2+21 ! leaving monsterport
  1513.           ELSE
  1514.             b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=(egg&(j&,9)+1)+42 ! leaving monsterport
  1515.           ENDIF
  1516.         ELSE
  1517.           SWAP b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&),b&(egg&(j&,1),egg&(j&,2))
  1518.         ENDIF
  1519.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1520.         egg&(j&,5)=egg&(j&,1)
  1521.         egg&(j&,6)=egg&(j&,2)
  1522.         ADD egg&(j&,2),dx&
  1523.         ADD egg&(j&,1),dy&
  1524.       ELSE IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=31 AND dy&=0 ! gone into monsterport
  1525.         egg&(j&,9)=dx& ! remember way that it's facing
  1526.         IF begg&<>31
  1527.           b&(egg&(j&,1),egg&(j&,2))=0
  1528.         ENDIF
  1529.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1530.         egg&(j&,5)=egg&(j&,1)
  1531.         egg&(j&,6)=egg&(j&,2)
  1532.         ADD egg&(j&,2),dx& ! move into teleport
  1533.         GOSUB monsterport
  1534.       ELSE
  1535.         IF begg&=31 ! turned round inside monsterport
  1536.           egg&(j&,9)=-egg&(j&,9)
  1537.           GOSUB monsterport
  1538.         ELSE
  1539.           IF egg&(j&,3)=4 !lefty/righty
  1540.             b&(egg&(j&,1),egg&(j&,2))=43-begg&
  1541.           ELSE
  1542.             INC b&(egg&(j&,1),egg&(j&,2))
  1543.             IF b&(egg&(j&,1),egg&(j&,2))=45
  1544.               SUB b&(egg&(j&,1),egg&(j&,2)),4
  1545.             ENDIF
  1546.           ENDIF
  1547.         ENDIF
  1548.         IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=45 AND dx&=-1 ! Pushed bubmac
  1549.           inlefty!=TRUE
  1550.           GOSUB startbubmac(egg&(j&,1)+dy&,egg&(j&,2)+dx&)
  1551.           inlefty!=FALSE
  1552.           GOSUB put(egg&(j&,1)+dy&,egg&(j&,2)+dx&)
  1553.           GOSUB put(egg&(j&,1)+dy&-1,egg&(j&,2)+dx&)
  1554.         ENDIF
  1555.         IF b&(egg&(j&,1)+dy&,egg&(j&,2)+dx&)=46 AND dx&=1 ! Pushed bubmac
  1556.           inlefty!=TRUE
  1557.           GOSUB startbubmac(egg&(j&,1)+dy&,egg&(j&,2)+dx&)
  1558.           inlefty!=FALSE
  1559.           GOSUB put(egg&(j&,1)+dy&,egg&(j&,2)+dx&)
  1560.           GOSUB put(egg&(j&,1)+dy&-1,egg&(j&,2)+dx&)
  1561.         ENDIF
  1562.       ENDIF
  1563.       jud:
  1564.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1565.     ENDIF
  1566.     IF egg&(j&,3)=6 AND egg&(j&,8)<>1 ! bubble machine (not just started by monster)
  1567.       egg&(j&,5)=egg&(j&,1)
  1568.       egg&(j&,6)=egg&(j&,2)
  1569.       IF begg&>=num&+4 AND begg&<=num&+7  ! Next anim frame
  1570.         INC b&(egg&(j&,1),egg&(j&,2))
  1571.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1572.       ELSE IF begg&=num&+8                ! Bubble finished
  1573.         b&(egg&(j&,1),egg&(j&,2))=28
  1574.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1575.         INC egg&(j&,1)
  1576.         SUB b&(egg&(j&,1),egg&(j&,2)),(num&-43)
  1577.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1578.         egg&(j&,7)=1 ! Do fall check
  1579.       ELSE IF begg&<>45 AND begg&<>46     ! Bubble destroyed while being made
  1580.         INC egg&(j&,1)
  1581.         SUB b&(egg&(j&,1),egg&(j&,2)),(num&-43)
  1582.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1583.       ENDIF
  1584.     ENDIF
  1585.     IF egg&(j&,3)=7 ! round-the-wall'er
  1586.       egg&(j&,5)=egg&(j&,1)
  1587.       egg&(j&,6)=egg&(j&,2)
  1588.       egg&(j&,7)=egg&(j&,1)
  1589.       egg&(j&,8)=egg&(j&,2)
  1590.       SELECT begg&
  1591.       CASE 47
  1592.         aheady&=egg&(j&,1)
  1593.         aheadx&=egg&(j&,2)-1
  1594.         belowy&=egg&(j&,1)+1
  1595.         belowx&=egg&(j&,2)
  1596.       CASE 48
  1597.         aheady&=egg&(j&,1)-1
  1598.         aheadx&=egg&(j&,2)
  1599.         belowy&=egg&(j&,1)
  1600.         belowx&=egg&(j&,2)-1
  1601.       CASE 49
  1602.         aheady&=egg&(j&,1)
  1603.         aheadx&=egg&(j&,2)+1
  1604.         belowy&=egg&(j&,1)-1
  1605.         belowx&=egg&(j&,2)
  1606.       CASE 50
  1607.         aheady&=egg&(j&,1)+1
  1608.         aheadx&=egg&(j&,2)
  1609.         belowy&=egg&(j&,1)
  1610.         belowx&=egg&(j&,2)+1
  1611.       ENDSELECT
  1612.       IF begg&=31
  1613.         IF b&(egg&(j&,1),egg&(j&,2)+egg&(j&,9))=0
  1614.           b&(egg&(j&,1),egg&(j&,2)+egg&(j&,9))=49-egg&(j&,9) ! -1=d 1=u
  1615.           ADD egg&(j&,2),egg&(j&,9)
  1616.         ELSE IF b&(egg&(j&,1),egg&(j&,2)+egg&(j&,9))=31
  1617.           ADD egg&(j&,2),egg&(j&,9)
  1618.           GOSUB monsterport
  1619.         ELSE
  1620.           GOSUB monsterport
  1621.           egg&(j&,9)=-egg&(j&,9)
  1622.         ENDIF
  1623.         GOTO quitmport
  1624.       ENDIF
  1625.       oeggn&=egg&(j&,9)
  1626.       egg&(j&,9)=0
  1627.       cornery&=aheady&+belowy&-egg&(j&,1)
  1628.       cornerx&=aheadx&+belowx&-egg&(j&,2)
  1629.       IF b&(belowy&,belowx&)=0 ! Nothing to support it
  1630.         IF gravity&<>0
  1631.           IF begg&=48 OR begg&=50
  1632.             b&(egg&(j&,1),egg&(j&,2))=47-gravity&+1 ! Left if gravity&=1, right if -1
  1633.           ELSE IF begg&<>47-gravity&+1
  1634.             b&(egg&(j&,1),egg&(j&,2))=50
  1635.           ENDIF
  1636.           egg&(j&,10)=1 ! Make it fall!
  1637.         ENDIF
  1638.       ELSE IF b&(belowy&,belowx&)=31 AND (begg&=48 OR begg&=50) AND oeggn&=0
  1639.         egg&(j&,9)=belowx&-egg&(j&,2)
  1640.         egg&(j&,2)=belowx&
  1641.         dx&=egg&(j&,9)
  1642.         GOSUB monsterport
  1643.         b&(egg&(j&,5),egg&(j&,6))=0
  1644.         GOSUB put(egg&(j&,5),egg&(j&,6))
  1645.       ELSE IF b&(aheady&,aheadx&)<>0 ! something ahead so rotate right, onto it
  1646.         INC b&(egg&(j&,1),egg&(j&,2))
  1647.         IF b&(egg&(j&,1),egg&(j&,2))=51
  1648.           b&(egg&(j&,1),egg&(j&,2))=47
  1649.         ENDIF
  1650.       ELSE IF b&(cornery&,cornerx&)<>0 ! something to advance onto
  1651.         egg&(j&,1)=aheady&
  1652.         egg&(j&,2)=aheadx&
  1653.         b&(egg&(j&,1),egg&(j&,2))=b&(egg&(j&,5),egg&(j&,6))
  1654.         b&(egg&(j&,5),egg&(j&,6))=0
  1655.         GOSUB put(egg&(j&,5),egg&(j&,6))
  1656.       ELSE ! rotate to left and go round corner
  1657.         egg&(j&,1)=cornery&
  1658.         egg&(j&,2)=cornerx&
  1659.         egg&(j&,7)=aheady&
  1660.         egg&(j&,8)=aheadx&
  1661.         b&(egg&(j&,1),egg&(j&,2))=b&(egg&(j&,5),egg&(j&,6))-1
  1662.         IF b&(egg&(j&,1),egg&(j&,2))=46
  1663.           b&(egg&(j&,1),egg&(j&,2))=50
  1664.         ENDIF
  1665.         b&(egg&(j&,5),egg&(j&,6))=0
  1666.         b&(egg&(j&,7),egg&(j&,8))=0
  1667.         GOSUB put(egg&(j&,5),egg&(j&,6))
  1668.         GOSUB put(egg&(j&,7),egg&(j&,8))
  1669.       ENDIF
  1670.       quitmport:
  1671.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1672.     ENDIF
  1673.   NEXT j&
  1674.   IF count&=0
  1675.     monster!=FALSE
  1676.   ENDIF
  1677. RETURN
  1678. PROCEDURE monsterport
  1679.   FOR noth&=1 TO 26 ! loop to find destination
  1680.     IF (egg&(j&,1)=tele&(noth&,1) AND egg&(j&,2)=tele&(noth&,2))
  1681.       egg&(j&,1)=tele&(noth&,3)
  1682.       egg&(j&,2)=tele&(noth&,4)
  1683.       EXIT IF 1
  1684.     ELSE IF (egg&(j&,1)=tele&(noth&,3) AND egg&(j&,2)=tele&(noth&,4))
  1685.       egg&(j&,1)=tele&(noth&,1)
  1686.       egg&(j&,2)=tele&(noth&,2)
  1687.       EXIT IF 1
  1688.     ENDIF
  1689.   NEXT noth&
  1690.   IF egg&(j&,1)=0 AND egg&(j&,2)=0 ! it's been killed
  1691.     egg&(j&,9)=2*SGN(dx&)
  1692.   ENDIF
  1693. RETURN
  1694. PROCEDURE monother
  1695.   FOR j&=1 TO maxmon& ! And jam into other screen
  1696.     IF egg&(j&,3)=1
  1697.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1698.     ENDIF
  1699.     IF egg&(j&,3)=0 AND crack!=FALSE
  1700.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1701.     ENDIF
  1702.     IF egg&(j&,3)=2 OR egg&(j&,3)=4 OR egg&(j&,3)=5 OR (egg&(j&,3)=6 AND egg&(j&,8)<>1)
  1703.       GOSUB put(egg&(j&,5),egg&(j&,6))
  1704.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1705.     ENDIF
  1706.     IF egg&(j&,3)=7
  1707.       GOSUB put(egg&(j&,5),egg&(j&,6))
  1708.       GOSUB put(egg&(j&,7),egg&(j&,8))
  1709.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1710.     ENDIF
  1711.     IF egg&(j&,8)=1 AND egg&(j&,3)=6
  1712.       GOSUB put(egg&(j&,1),egg&(j&,2))
  1713.       GOSUB put(egg&(j&,1)+1,egg&(j&,2))
  1714.       egg&(j&,8)=0
  1715.     ENDIF
  1716.     IF egg&(j&,11)<>0 OR egg&(j&,12)<>0
  1717.       GOSUB put(egg&(j&,1)+SGN(egg&(j&,12)),egg&(j&,2)+SGN(egg&(j&,11)))
  1718.     ENDIF
  1719.   NEXT j&
  1720.   FOR j&=1 TO maxmon&
  1721.     IF ABS(egg&(j&,11))=2 OR ABS(egg&(j&,12))=2
  1722.       GOSUB explode(egg&(j&,1)+SGN(egg&(j&,12)),egg&(j&,2)+SGN(egg&(j&,11)))
  1723.     ENDIF
  1724.     IF ABS(egg&(j&,9))=2 ! monsterport explodes on lefty/righty/bouncy
  1725.       IF b&(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))=31 ! and not already blown up
  1726.         b&(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))=0
  1727.         GOSUB put(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))
  1728.         GOSUB swapscreen
  1729.         GOSUB put(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))
  1730.         GOSUB explode(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))
  1731.       ENDIF
  1732.     ENDIF
  1733.   NEXT j&
  1734.   IF manikx&<>0 OR maniky&<>0
  1735.     IF manikx&<>100 AND maniky&<>100
  1736.       b&(maniky&,manikx&)=0
  1737.       GOSUB explode(maniky&,manikx&)
  1738.     ENDIF
  1739.     IF b&(many&,manx&)=2
  1740.       b&(many&,manx&)=0
  1741.       GOSUB explode(many&,manx&)
  1742.     ENDIF
  1743.     manikx&=0
  1744.     mainky&=0
  1745.   ENDIF
  1746. RETURN
  1747. PROCEDURE monfall
  1748.   FOR j&=1 TO maxmon&
  1749.     IF egg&(j&,5)<>egg&(j&,1) OR egg&(j&,6)<>egg&(j&,2)
  1750.       GOSUB check(egg&(j&,5),egg&(j&,6))
  1751.     ENDIF
  1752.     IF egg&(j&,7)=1 AND egg&(j&,3)=2
  1753.       GOSUB check(egg&(j&,1),egg&(j&,2))
  1754.       egg&(j&,7)=0
  1755.     ENDIF
  1756.     IF egg&(j&,7)=1 AND egg&(j&,3)=6
  1757.       IF s!(b&(egg&(j&,1)-1,egg&(j&,2)),1)
  1758.         GOSUB fallch(egg&(j&,1)-1,egg&(j&,2))
  1759.       ENDIF
  1760.       egg&(j&,7)=0
  1761.     ENDIF
  1762.     IF egg&(j&,11)<>0
  1763.       GOSUB check(egg&(j&,1),egg&(j&,2))
  1764.       egg&(j&,11)=0
  1765.     ENDIF
  1766.     IF egg&(j&,12)<>0
  1767.       GOSUB check(egg&(j&,1),egg&(j&,2))
  1768.       egg&(j&,12)=0
  1769.     ENDIF
  1770.     IF egg&(j&,3)=7 AND (egg&(j&,7)<>egg&(j&,1) OR egg&(j&,8)<>egg&(j&,2))
  1771.       GOSUB check(egg&(j&,7),egg&(j&,8))
  1772.     ENDIF
  1773.     IF egg&(j&,10)=1 AND egg&(j&,3)=7
  1774.       ' fall roundy
  1775.       WHILE b&(egg&(j&,1)+gravity&,egg&(j&,2))=0
  1776.         b&(egg&(j&,1)+gravity&,egg&(j&,2))=47-gravity&+1
  1777.         b&(egg&(j&,1),egg&(j&,2))=0
  1778.         onscr!=FALSE
  1779.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1780.         GOSUB put(egg&(j&,1)+gravity&,egg&(j&,2))
  1781.         IF onscr!
  1782.           GOSUB swapscreen ! ***
  1783.         ENDIF
  1784.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1785.         GOSUB put(egg&(j&,1)+gravity&,egg&(j&,2))
  1786.         ADD egg&(j&,1),gravity&
  1787.       WEND
  1788.       IF b&(egg&(j&,1),egg&(j&,2))<>47-gravity&+1 ! if not had time to rotate as falling
  1789.         b&(egg&(j&,1),egg&(j&,2))=47-gravity&+1
  1790.         onscr!=FALSE
  1791.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1792.         IF onscr!
  1793.           GOSUB swapscreen ! ***
  1794.         ENDIF
  1795.         GOSUB put(egg&(j&,1),egg&(j&,2))
  1796.       ENDIF
  1797.       egg&(j&,10)=0
  1798.     ENDIF
  1799.     IF ABS(egg&(j&,9))=2 ! fall check when monsterport explodes due to no destination
  1800.       GOSUB check(egg&(j&,5),egg&(j&,6)+SGN(egg&(j&,9)))
  1801.       egg&(j&,9)=0
  1802.       egg&(j&,3)=3 ! monster dead
  1803.     ENDIF
  1804.   NEXT j&
  1805. RETURN
  1806. PROCEDURE startbubmac(bmy&,bmx&)
  1807.   IF b&(bmy&-1,bmx&)=0
  1808.     b&(bmy&,bmx&)=b&(bmy&,bmx&)-43+num&
  1809.     b&(bmy&-1,bmx&)=num&+4
  1810.     found!=flase
  1811.     FOR bml&=1 TO maxmon&
  1812.       IF egg&(bml&,1)=bmy& AND egg&(bml&,2)=bmx&
  1813.         found!=TRUE
  1814.         DEC egg&(bml&,1)
  1815.         IF inlefty!
  1816.           egg&(bml&,8)=1 ! record that we were set of by lefty/righty/bouncy
  1817.         ENDIF
  1818.         EXIT IF 1
  1819.       ENDIF
  1820.     NEXT bml&
  1821.     IF NOT (found!)
  1822.       PRINT AT(10,10);"Not found!"
  1823.       EDIT
  1824.     ENDIF
  1825.   ENDIF
  1826. RETURN
  1827. ' change "allfall" for monsters as well
  1828. PROCEDURE variables
  1829.   debug!=FALSE
  1830.   autoload!=FALSE
  1831.   sprite!=FALSE
  1832.   oink$="!"
  1833.   default$="TRAINING"
  1834.   dispx&=-18
  1835.   dispy&=-18
  1836.   LET spritex&=252
  1837.   LET spritey&=10
  1838.   maxmaxmon&=100 ! Number of monsters maximum
  1839.   de&=5 ! Shake distance
  1840.   autoload$="" ! Long comment... humn. (Don't mind me, you get mad after a few hours - as a mathematician said, "I hate programming, for example I spent three hours yesterday getting the caption to look right on the laser printout. Just the caption. Yuck
  1841.   '
  1842.   RESTORE paths
  1843.   REPEAT
  1844.     READ path$
  1845.     IF EXIST(path$+"DEFAULT.LVL")
  1846.       $U
  1847.       OPEN "i",#1,path$+"DEFAULT.LVL"
  1848.       $U
  1849.       FRONTS 2
  1850.       INPUT #1;default$
  1851.       INPUT #1;dispx&
  1852.       INPUT #1;dispy&
  1853.       INPUT #1;path$
  1854.       IF NOT (EOF(#1))
  1855.         INPUT #1;spritex&
  1856.         INPUT #1;spritey&
  1857.       ENDIF
  1858.       CLOSE #1
  1859.       EXIT IF 1
  1860.     ENDIF
  1861.     EXIT IF EXIST(path$)
  1862.   UNTIL path$="***"
  1863.   IF path$="***"
  1864.     path$=""
  1865.   ENDIF
  1866.   '
  1867.   paths:
  1868.   DATA "","Levels/","PlasmaBubble:","PlasmaBubble:Levels/","***"
  1869.   '
  1870.   DIM b&(21,31)   ! Playing board - extra 0 & 21, 0 & 31 for curvify - nulls round edge?
  1871.   DIM ob&(21,31)  ! Editor board
  1872.   DIM gt|(20,30) ! Get/Put area
  1873.   CLR gtx&,gty&
  1874.   DIM tele&(26,4) ! SourceY, SourceX, DestY, DestX
  1875.   DIM s!(num&+10,12)  ! Stats on objects
  1876.   DIM pr$(num&+10,2) ! Printer character & Text Description
  1877.   DIM map!(20,30)
  1878.   DIM match&(5) ! used by Splurge! procedure
  1879.   '
  1880.   egg&=8 ! Maximum cracky/hatchy
  1881.   crack!=FALSE
  1882.   DIM egg&(maxmaxmon&,12) ! Y, X, State (0 Wait, 1 Crack, 2 Hatchy, 3 Dead, 4 Lefty/Righty, 5 Bouncy, 6 Bub. Mac.)
  1883.   '                       ! Anim, LastY, LastX, Check?, 8=BubMac, 9=Face, 11=BangX! 12=BangY!
  1884.   '
  1885.   RESTORE stat
  1886.   FOR f&=0 TO num&+8
  1887.     FOR g&=1 TO 12
  1888.       READ s!(f&,g&)
  1889.     NEXT g&
  1890.     READ pr$(f&,1),pr$(f&,2)
  1891.   NEXT f&
  1892.   '
  1893.   stat:
  1894.   ' Fall? Walk thro'? Kill? Push/Fall Thro'? Roll left? Roll right? Push? Score?
  1895.   ' Explode? Bubble go thro'? Roll bottom left? Roll bottom right?
  1896.   DATA 0,1,0,1,0,0,0,0,0,1,0,0, ,Nothing
  1897.   DATA 1,0,0,0,1,1,1,0,0,0,1,1,O,Boulder
  1898.   DATA 0,0,0,0,1,1,0,0,0,0,1,1,@,You
  1899.   DATA 0,1,0,0,1,1,0,1,0,0,1,1,^,Diamond
  1900.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Wall
  1901.   DATA 0,1,0,0,0,0,0,0,0,1,0,0,E,Earth
  1902.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mine
  1903.   DATA 1,1,0,0,1,1,0,1,0,0,1,1,^,Falling Diamond
  1904.   DATA 0,0,0,0,0,1,0,0,0,0,0,0,\,Top Right Curve
  1905.   DATA 0,0,0,0,1,0,0,0,0,0,0,0,/,Top Left Curve
  1906.   '
  1907.   DATA 1,0,0,0,1,1,1,0,0,0,1,1,&,Egg
  1908.   DATA 0,0,0,0,0,0,0,0,0,0,0,1,/,Low Right Curve
  1909.   DATA 0,0,0,0,0,0,0,0,0,0,1,0,\,Low Left Curve
  1910.   DATA 0,1,0,1,0,0,0,0,0,1,0,0,.,Plant 1
  1911.   DATA 0,1,0,1,0,0,0,0,0,1,0,0,.,Plant 2
  1912.   DATA 0,1,0,1,0,0,0,0,0,1,0,0,.,Plant 3
  1913.   DATA 0,1,0,1,0,0,0,0,0,1,0,0,.,Hanging Plant
  1914.   DATA 0,0,0,0,0,0,1,0,0,0,0,0,#,Pushable Wall
  1915.   DATA 0,0,0,0,1,1,0,0,0,0,1,1,M,Manikin
  1916.   DATA 1,0,0,0,1,1,1,0,0,0,1,1,&,Cracking Egg
  1917.   '
  1918.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,"",Hatchling
  1919.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,<,Lefty
  1920.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,>,Righty
  1921.   DATA 0,0,0,0,1,1,0,0,0,0,0,0,#,Top Curve
  1922.   DATA 0,0,0,0,0,0,0,0,0,0,1,1,#,Bottom Curve
  1923.   DATA 0,0,0,0,1,0,0,0,0,0,1,0,(,Left Curve
  1924.   DATA 0,0,0,0,0,1,0,0,0,0,0,1,),Right Curve
  1925.   DATA 0,1,0,0,0,0,0,0,0,0,0,0,T,Teleport
  1926.   DATA 1,0,0,0,1,1,1,0,0,0,1,1,B,Bubble
  1927.   DATA 0,0,0,0,1,1,0,0,0,0,1,1,#,Circular Wall
  1928.   '
  1929.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Invisible Wall
  1930.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,-,Monsterport
  1931.   DATA 0,0,0,0,1,0,0,0,0,0,0,0,/,Top Left Diag.
  1932.   DATA 0,0,0,0,0,1,0,0,0,0,0,0,\,Top Right Diag.
  1933.   DATA 0,0,0,0,0,0,0,0,0,0,1,0,\,Low Left Diag.
  1934.   DATA 0,0,0,0,0,0,0,0,0,0,0,1,/,Low Right Diag.
  1935.   DATA 0,0,0,0,1,1,0,0,0,0,0,0,#,Top Pointy
  1936.   DATA 0,0,0,0,0,1,0,0,0,0,0,1,),Right Pointy
  1937.   DATA 0,0,0,0,0,0,0,0,0,0,1,1,#,Bottom Pointy
  1938.   DATA 0,0,0,0,1,0,0,0,0,0,1,0,(,Left Pointy
  1939.   '
  1940.   DATA 0,0,0,0,1,1,0,0,0,0,1,1,#,Rhombus Wall
  1941.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,U,Bouncy Up
  1942.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,L,Bouncy Left
  1943.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,D,Bouncy Down
  1944.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,R,Bouncy Right
  1945.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Bub Machine R
  1946.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Bub Machine L
  1947.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,l,Roundy Left
  1948.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,u,Roundy Up
  1949.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,r,Roundy Right
  1950.   '
  1951.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,d,Roundy Down
  1952.   '
  1953.   DATA 1,0,0,0,1,1,1,0,0,0,1,1,&,Waiting Crack
  1954.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Bub Mac. 2 R
  1955.   DATA 0,0,0,0,0,0,0,0,0,0,0,0,#,Bub Mac. 2 L
  1956.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mac. Anim. 1
  1957.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mac. Anim. 2
  1958.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mac. Anim. 3
  1959.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mac. Anim. 4
  1960.   DATA 0,1,1,1,0,0,0,0,1,0,0,0,*,Mac. Anim. 5
  1961.   '
  1962.   ' Fall? Walk thro'? Kill? Push/Fall Thro'? Roll left? Roll right? Push? Score?
  1963.   ' Explode? Bubble go thro'?
  1964. RETURN
  1965. PROCEDURE eachtime
  1966.   score&=0
  1967.   dead!=FALSE
  1968.   gotit!=FALSE
  1969.   monster!=FALSE
  1970.   crack!=FALSE
  1971.   prin!=FALSE
  1972.   manikx&=0
  1973.   maniky&=0
  1974.   ARRAYFILL egg&(),3
  1975.   ARRAYFILL map!(),FALSE
  1976.   a$(19)=egg$(1)
  1977.   odmanx&=0
  1978.   odmany&=1
  1979.   a$(2)=man$(4)
  1980. RETURN
  1981. PROCEDURE check(y&,x&)
  1982.   IF s!(b&(y&-1,x&),1)
  1983.     GOSUB fallch(y&-1,x&)
  1984.   ENDIF
  1985.   IF s!(b&(y&-1,x&-1),1)
  1986.     GOSUB fallch(y&-1,x&-1)
  1987.   ENDIF
  1988.   IF s!(b&(y&-1,x&+1),1)
  1989.     GOSUB fallch(y&-1,x&+1)
  1990.   ENDIF
  1991.   IF s!(b&(y&+1,x&),1)
  1992.     GOSUB fallch(y&+1,x&)
  1993.   ENDIF
  1994.   IF s!(b&(y&+1,x&-1),1)
  1995.     GOSUB fallch(y&+1,x&-1)
  1996.   ENDIF
  1997.   IF s!(b&(y&+1,x&+1),1)
  1998.     GOSUB fallch(y&+1,x&+1)
  1999.   ENDIF
  2000.   IF s!(b&(y&,x&-1),1)
  2001.     GOSUB fallch(y&,x&-1)
  2002.   ENDIF
  2003.   IF s!(b&(y&,x&+1),1)
  2004.     GOSUB fallch(y&,x&+1)
  2005.   ENDIF
  2006. RETURN
  2007. PROCEDURE fallch(ee&,tt&)
  2008.   LOCAL mov!,e&,t&,jackdiddley&,dir&,flag!,fnarl&,updown&,check&
  2009.   e&=ee&
  2010.   t&=tt&
  2011.   mov!=FALSE
  2012.   updown&=gravity& ! 1 - Things fall down, -1 - Things fall up
  2013.   check&=4 ! Which part of s! holds things this thing can fall thro'
  2014.   IF b&(e&,t&)=28
  2015.     updown&=-1
  2016.     check&=10
  2017.   ENDIF
  2018.   IF updown&=0
  2019.     GOTO ret
  2020.   ENDIF
  2021.   CLR jackdiddley&
  2022.   IF b&(e&,t&)=num&+1 OR b&(e&,t&)=19 ! If cracking egg, find it's number
  2023.     FOR i&=1 TO maxmon&
  2024.       IF egg&(i&,3)<>3 AND e&=egg&(i&,1) AND t&=egg&(i&,2)
  2025.         jackdiddley&=i&
  2026.       ENDIF
  2027.     NEXT i&
  2028.   ENDIF
  2029.   fnarl&=29 ! Fnarl is an idosyncratic variable used to replace whatever
  2030.   '         ! is falling with an unfallable wall otherwise identicle to
  2031.   '         ! all falling objects. This prevents the object falling in the
  2032.   '         ! recursive routines it calls.
  2033.   fallch:
  2034.   ' fall sequence in order of priority
  2035.   IF mov! AND (b&(e&+updown&,t&)=2 OR b&(e&+updown&,t&)=18) ! You or Manikins die!
  2036.     b&(e&,t&)=0
  2037.     GOSUB put(e&,t&)
  2038.     GOSUB swapscreen ! ***
  2039.     GOSUB put(e&,t&)
  2040.     IF b&(e&+updown&,t&)=18
  2041.       b&(e&+updown&,t&)=0
  2042.       GOSUB explode(e&+updown&,t&)
  2043.     ENDIF
  2044.     IF b&(many&,manx&)=2
  2045.       b&(many&,manx&)=0
  2046.       GOSUB explode(many&,manx&)
  2047.     ENDIF
  2048.     b&(e&+updown&,t&)=0
  2049.     dead!=TRUE
  2050.     GOTO ret
  2051.   ENDIF
  2052.   IF mov! AND b&(e&,t&)=10 AND NOT s!(b&(e&+updown&,t&),check&)
  2053.     GOSUB makeegg
  2054.     jackdiddley&=i&
  2055.   ENDIF
  2056.   IF mov! AND (NOT s!(b&(e&+updown&,t&),check&)) AND t&=>manx&-4 AND e&>many&-3 AND t&<manx&+5 AND e&<many&+4 AND b&(e&,t&)<>28 AND b&(e&,t&)<>7   ! Shake screen (?)
  2057.     shx&=RANDOM(2)*2-1
  2058.     shy&=RANDOM(2)*2-1
  2059.     de&=5
  2060.     SUB dispx&,de&*shx&
  2061.     SUB dispy&,de&*shy&
  2062.     GOSUB displaymove
  2063.     ADD dispx&,de&*shx&
  2064.     ADD dispy&,de&*shy&
  2065.     GOSUB displaymove
  2066.   ENDIF
  2067.   IF s!(b&(e&+updown&,t&),check&)
  2068.     IF s!(b&(e&+updown&,t&),9) ! Mine
  2069.       b&(e&+updown&,t&)=0
  2070.       b&(e&,t&)=0
  2071.       GOSUB put(e&,t&)
  2072.       GOSUB swapscreen ! ***
  2073.       GOSUB put(e&,t&)
  2074.       GOSUB explode(e&+updown&,t&)
  2075.       GOSUB check(e&,t&)
  2076.       GOSUB check(e&+updown&,t&)
  2077.       GOTO ret
  2078.     ENDIF
  2079.     b&(e&+updown&,t&)=b&(e&,t&)
  2080.     b&(e&,t&)=0
  2081.     mov!=TRUE
  2082.     '
  2083.     onscr!=FALSE
  2084.     GOSUB put(e&,t&)
  2085.     GOSUB put(e&+updown&,t&)
  2086.     IF onscr!
  2087.       GOSUB swapscreen ! ***
  2088.     ENDIF
  2089.     GOSUB put(e&,t&)
  2090.     GOSUB put(e&+updown&,t&)
  2091.     '
  2092.     ADD e&,updown&
  2093.     SWAP b&(e&,t&),fnarl&
  2094.     GOSUB jackdiddle
  2095.     GOSUB check(e&-updown&,t&)
  2096.     SWAP b&(e&,t&),fnarl&
  2097.     GOTO fallch
  2098.   ENDIF
  2099.   flag!=FALSE
  2100.   FOR dir&=-1 TO 1 STEP 2 ! Check for roling in each direction
  2101.     IF s!(b&(e&+updown&,t&),5+SGN(dir&+1)+3*(1-updown&)) AND s!(b&(e&,t&+dir&),check&) AND s!(b&(e&+updown&,t&+dir&),check&)
  2102.       IF s!(b&(e&,t&+dir&),9) ! Mine
  2103.         b&(e&,t&+dir&)=0
  2104.         b&(e&,t&)=0
  2105.         GOSUB put(e&,t&)
  2106.         GOSUB swapscreen ! ***
  2107.         GOSUB put(e&,t&)
  2108.         GOSUB explode(e&,t&+dir&)
  2109.         GOSUB check(e&,t&+dir&)
  2110.         GOSUB check(e&,t&)
  2111.         ADD t&,dir&
  2112.         LET dir&=2
  2113.       ELSE
  2114.         b&(e&,t&+dir&)=b&(e&,t&)
  2115.         b&(e&,t&)=0
  2116.         mov!=TRUE
  2117.         '
  2118.         onscr!=FALSE
  2119.         GOSUB put(e&,t&)
  2120.         GOSUB put(e&,t&+dir&)
  2121.         IF onscr!
  2122.           GOSUB swapscreen ! ***
  2123.         ENDIF
  2124.         GOSUB put(e&,t&)
  2125.         GOSUB put(e&,t&+dir&)
  2126.         '
  2127.         ADD t&,dir&
  2128.         SWAP b&(e&,t&),fnarl&
  2129.         GOSUB jackdiddle
  2130.         GOSUB check(e&,t&-dir&)
  2131.         SWAP b&(e&,t&),fnarl&
  2132.         flag!=TRUE
  2133.       ENDIF
  2134.     ENDIF
  2135.     EXIT IF flag!
  2136.   NEXT dir&
  2137.   IF flag!
  2138.     GOTO fallch
  2139.   ENDIF
  2140.   ret:
  2141.   GOSUB jackdiddle
  2142. RETURN
  2143. PROCEDURE jackdiddle
  2144.   IF jackdiddley& AND mov!
  2145.     egg&(jackdiddley&,1)=e&
  2146.     egg&(jackdiddley&,2)=t&
  2147.   ENDIF
  2148. RETURN
  2149. PROCEDURE levelscan
  2150.   LOCAL e&,t&
  2151.   maxmon&=0
  2152.   FOR e&=1 TO 20
  2153.     FOR t&=1 TO 30
  2154.       IF b&(e&,t&)=10 OR (b&(e&,t&)=>19 AND b&(e&,t&)<=22) OR (b&(e&,t&)=>41 AND b&(e&,t&)<=50)
  2155.         INC maxmon&
  2156.       ENDIF
  2157.     NEXT t&
  2158.   NEXT e&
  2159.   IF maxmon&>maxmaxmon&
  2160.     OPENW #2
  2161.     CLEARW #2
  2162.     FRONTS 2
  2163.     x$="Over "+STR$(maxmaxmon&)+" monsters/bubble"
  2164.     GOSUB text((height&/2)-10,1)
  2165.     x$="machines on this level. Please use less."
  2166.     GOSUB text((height&/2)+10,1)
  2167.     GOSUB nosprite
  2168.     GOSUB fade(15)
  2169.     GOSUB pause
  2170.     dead!=TRUE
  2171.     GOTO leaveproc
  2172.   ENDIF
  2173. RETURN
  2174. PROCEDURE allfall
  2175.   FOR e&=1 TO 20
  2176.     FOR t&=1 TO 30
  2177.       IF b&(e&,t&)=19 ! Already cracking egg
  2178.         GOSUB makeegg
  2179.       ENDIF
  2180.       IF b&(e&,t&)=20 ! Hatchling at start
  2181.         GOSUB makehatchy
  2182.       ENDIF
  2183.       IF b&(e&,t&)=21 OR b&(e&,t&)=22
  2184.         FOR i&=1 TO maxmon&
  2185.           IF egg&(i&,3)=3
  2186.             monster!=TRUE
  2187.             egg&(i&,1)=e&
  2188.             egg&(i&,2)=t&
  2189.             egg&(i&,3)=4
  2190.             egg&(i&,11)=0
  2191.             egg&(i&,9)=0
  2192.             EXIT IF 1
  2193.           ENDIF
  2194.         NEXT i&
  2195.       ENDIF
  2196.       IF b&(e&,t&)>=41 AND b&(e&,t&)<=44
  2197.         GOSUB makebouncy
  2198.       ENDIF
  2199.       IF b&(e&,t&)=45 OR b&(e&,t&)=46
  2200.         FOR i&=1 TO maxmon&
  2201.           IF egg&(i&,3)=3
  2202.             monster!=TRUE
  2203.             egg&(i&,1)=e&
  2204.             egg&(i&,2)=t&
  2205.             egg&(i&,3)=6
  2206.             egg&(i&,7)=0
  2207.             EXIT IF 1
  2208.           ENDIF
  2209.         NEXT i&
  2210.       ENDIF
  2211.       IF b&(e&,t&)=>47 AND b&(e&,t&)<=50
  2212.         FOR i&=1 TO maxmon&
  2213.           IF egg&(i&,3)=3
  2214.             monster!=TRUE
  2215.             egg&(i&,1)=e&
  2216.             egg&(i&,2)=t&
  2217.             egg&(i&,3)=7
  2218.             egg&(i&,9)=0
  2219.             egg&(i&,10)=0
  2220.             EXIT IF 1
  2221.           ENDIF
  2222.         NEXT i&
  2223.       ENDIF
  2224.     NEXT t&
  2225.   NEXT e&
  2226.   FOR e&=1 TO 20
  2227.     FOR t&=1 TO 30
  2228.       IF s!(b&(e&,t&),1)
  2229.         GOSUB fallch(e&,t&)
  2230.       ENDIF
  2231.     NEXT t&
  2232.   NEXT e&
  2233. RETURN
  2234. '
  2235. ' Level Manipulation
  2236. PROCEDURE selectlevel
  2237.   again:
  2238.   IF autoload$=""
  2239.     x$="Enter Password:"
  2240.     GOSUB text((height&/2)-12,1)
  2241.     x$="(Return for "+default$+")"
  2242.     GOSUB text((height&/2)+16,1)
  2243.     IF menu&=1
  2244.       x$="(Try these levels: TUTORIAL, TRAINING,"
  2245.       GOSUB text((height&/2)+97,1)
  2246.       x$="SENSIBLE, ROCKHARD, AAAARGH!)"
  2247.       GOSUB text((height&/2)+115,1)
  2248.     ENDIF
  2249.     GOSUB fade(15)
  2250.     PRINT AT(width&/16-3,height&/16+1);
  2251.     FORM INPUT 8,type$
  2252.     '
  2253.     GOSUB fade(0)
  2254.   ELSE
  2255.     type$=autoload$
  2256.     autoload$=""
  2257.   ENDIF
  2258.   type$=UPPER$(type$)
  2259.   IF type$=""
  2260.     type$=default$
  2261.   ENDIF
  2262.   SWAP type$,default$
  2263.   GOSUB encode
  2264.   file$=path$+encoded$+".PLASMA"
  2265.   brk!=FALSE
  2266.   CLEARW #sit&
  2267.   IF encoded$="@xa2nQ"
  2268.     debug!=FALSE
  2269.     x$="Debug mode deactivated."
  2270.     GOSUB text((height&/2),1)
  2271.     GOSUB fade(15)
  2272.     GOSUB pause
  2273.     GOSUB fade(0)
  2274.     SWAP type$,default$
  2275.     CLEARW #sit&
  2276.     GOTO again
  2277.   ENDIF
  2278.   IF LEFT$(default$,4)="END:"
  2279.     x$="Passwords commencing ""END:"" signify"
  2280.     GOSUB text((height&/2)-20,1)
  2281.     x$="the end of a stream, and can only be"
  2282.     GOSUB text((height&/2)+0,1)
  2283.     x$="used to edit the last level."
  2284.     GOSUB text((height&/2)+20,1)
  2285.     GOSUB fade(15)
  2286.     GOSUB pause
  2287.     GOSUB fade(0)
  2288.     SWAP type$,default$
  2289.     CLEARW #sit&
  2290.     GOTO again
  2291.   ENDIF
  2292.   IF encoded$="ghkHcdl^"
  2293.     debug!=TRUE
  2294.     x$="Hello Francis."
  2295.     GOSUB text((height&/2)-10,1)
  2296.     x$="Debug mode activated."
  2297.     GOSUB text((height&/2)+10,1)
  2298.     GOSUB fade(15)
  2299.     GOSUB pause
  2300.     GOSUB fade(0)
  2301.     SWAP type$,default$
  2302.     CLEARW #sit&
  2303.     GOTO again
  2304.   ENDIF
  2305.   IF encoded$="u6<<*Xgx"
  2306.     x$="I'm sorry, my friend, but that"
  2307.     GOSUB text((height&/2)-10,1)
  2308.     x$="debug code has been changed."
  2309.     GOSUB text((height&/2)+10,1)
  2310.     GOSUB soundplay(2,63)
  2311.     GOSUB fade(15)
  2312.     GOSUB pause
  2313.     GOSUB fade(0)
  2314.     SWAP type$,default$
  2315.     CLEARW #sit&
  2316.     GOTO again
  2317.   ENDIF
  2318.   IF encoded$="=X6`0R!="
  2319.     x$="""Enter Password:"""
  2320.     GOSUB text((height&/2)-20,1)
  2321.     x$="And what does he type?"
  2322.     GOSUB text((height&/2)-0,1)
  2323.     x$="""Password."" Smart arse."
  2324.     GOSUB text((height&/2)+20,1)
  2325.     GOSUB fade(15)
  2326.     GOSUB pause
  2327.     GOSUB fade(0)
  2328.     SWAP type$,default$
  2329.     CLEARW #sit&
  2330.     GOTO again
  2331.   ENDIF
  2332.   IF NOT EXIST(file$)
  2333.     FRONTS 2
  2334.     SWAP type$,default$
  2335.     brk!=TRUE
  2336.     GOTO ret
  2337.   ENDIF
  2338.   ARRAYFILL tele&(),0
  2339.   pushywall&=0
  2340.   '
  2341.   $U
  2342.   OPEN "i",#1,file$
  2343.   $U
  2344.   FRONTS 2
  2345.   FOR f&=1 TO 20
  2346.     FOR g&=1 TO 30
  2347.       b&(f&,g&)=INP(#1)
  2348.       IF b&(f&,g&)=17
  2349.         INC pushywall&
  2350.       ENDIF
  2351.       IF b&(f&,g&)=2
  2352.         manx&=g&
  2353.         many&=f&
  2354.       ENDIF
  2355.       IF b&(f&,g&)>100
  2356.         tel&=b&(f&,g&)-100
  2357.         type&=31    ! monsterports in the 100s
  2358.         IF tel&>100 ! ordinary portals in the 200s
  2359.           tel&=tel&-100
  2360.           type&=27
  2361.         ENDIF
  2362.         IF tele&(tel&,1)=0 AND tele&(tel&,2)=0
  2363.           tele&(tel&,1)=f&
  2364.           tele&(tel&,2)=g&
  2365.           b&(f&,g&)=type&
  2366.         ELSE IF tele&(tel&,3)=0 AND tele&(tel&,4)=0
  2367.           tele&(tel&,3)=f&
  2368.           tele&(tel&,4)=g&
  2369.           b&(f&,g&)=type&
  2370.         ELSE
  2371.           b&(f&,g&)=0
  2372.         ENDIF
  2373.       ENDIF
  2374.       IF b&(f&,g&)>num& OR b&(f&,g&)<0
  2375.         b&(f&,g&)=0
  2376.       ENDIF
  2377.       IF EOF(#1)
  2378.         brk!=TRUE
  2379.         EXIT IF 1
  2380.       ENDIF
  2381.     NEXT g&
  2382.     EXIT IF brk!
  2383.   NEXT f&
  2384.   IF NOT EOF(#1)
  2385.     needed&=CVI(INPUT$(2,#1))
  2386.     map&=INP(#1)
  2387.     len&=INP(#1)
  2388.     next$=""
  2389.     FOR f&=1 TO len&
  2390.       next$=next$+CHR$(INP(#1)-87)
  2391.     NEXT f&
  2392.   ENDIF
  2393.   IF NOT EOF(#1)
  2394.     gravity&=INP(#1)-1
  2395.   ELSE
  2396.     gravity&=1
  2397.   ENDIF
  2398.   IF NOT EOF(#1)
  2399.     LINE INPUT #1,author$
  2400.   ELSE
  2401.     author$="Unknown"
  2402.   ENDIF
  2403.   CLOSE #1
  2404. RETURN
  2405. PROCEDURE savelevel
  2406.   GOSUB encode
  2407.   file$=path$+encoded$+".PLASMA"
  2408.   IF NOT (EXIST(path$))
  2409.     FRONTS 2
  2410.     ~DisplayBeep(SCREEN(2))
  2411.     GOTO leaveproc
  2412.   ENDIF
  2413.   $U
  2414.   OPEN "o",#1,file$
  2415.   $U
  2416.   FRONTS 2
  2417.   FOR f&=1 TO 20
  2418.     FOR g&=1 TO 30
  2419.       IF b&(f&,g&)<>27 AND b&(f&,g&)<>31 ! Teleport
  2420.         OUT #1,b&(f&,g&)
  2421.       ELSE
  2422.         FOR h&=1 TO 26
  2423.           IF (f&=tele&(h&,1) AND g&=tele&(h&,2)) OR (f&=tele&(h&,3) AND g&=tele&(h&,4))
  2424.             IF b&(f&,g&)=27
  2425.               OUT #1,200+h&
  2426.             ELSE
  2427.               OUT #1,100+h&
  2428.             ENDIF
  2429.             EXIT IF 1
  2430.           ENDIF
  2431.         NEXT h&
  2432.       ENDIF
  2433.     NEXT g&
  2434.   NEXT f&
  2435.   PRINT #1;MKI$(needed&);
  2436.   OUT #1,map& MOD 256
  2437.   OUT #1,LEN(next$)
  2438.   FOR f&=1 TO LEN(next$)
  2439.     OUT #1,(ASC(MID$(next$,f&,1))+87) MOD 256
  2440.   NEXT f&
  2441.   OUT #1,gravity&+1
  2442.   PRINT #1,author$
  2443.   CLOSE #1
  2444.   leaveproc:
  2445. RETURN
  2446. PROCEDURE drawlevel
  2447.   xb&=8
  2448.   yb&=8
  2449.   tog&=28
  2450.   GOSUB icons
  2451.   tele&=1
  2452.   GOSUB teleletter
  2453.   GET xb&,yb&+171,xb&+221,yb&+171+98,tog1$
  2454.   tog&=0
  2455.   GOSUB icons
  2456.   GOSUB teleletter
  2457.   GET xb&,yb&+171,xb&+221,yb&+171+98,tog0$
  2458.   GOSUB buttons
  2459.   PRINT AT(30,32+kon&);"Diamonds: ";needed&
  2460.   BOX xb&+302,yb&-kon&+246,xb&+344,yb&-kon&+258
  2461.   PRINT AT(30,30+kon&);"Next: ";next$
  2462.   BOX xb&+270,yb&-kon&+230,xb&+344,yb&-kon&+242
  2463.   PRINT AT(30,28+kon&);"This: ";default$
  2464.   BOX xb&+270,yb&-kon&+214,xb&+344,yb&-kon&+226
  2465.   GOSUB encode
  2466.   PRINT AT(30,26+kon&);"File: ";encoded$
  2467.   select&=0
  2468.   COLOR 2
  2469.   line&=0
  2470.   linex&=-1
  2471.   liney&=-1
  2472.   '
  2473.   COLOR 1
  2474.   BOX xb&+255,yb&+8*14-4,xb&+266,yb&+8*14+10 ! Boxes for X flip
  2475.   BOX xb&+318,yb&+8*14-4,xb&+329,yb&+8*14+10 !       for Y flip
  2476.   BOX xb&+255,yb&+3*14-4,xb&+292,yb&+3*14+10 !   and for Save/Load
  2477.   '
  2478.   COLOR 2
  2479.   GOSUB box(select&)
  2480.   GOSUB putbig
  2481.   PRINT AT(30,23+kon&);pr$(select&+tog&,2)
  2482.   GOSUB fade(15)
  2483.   COLOR 1
  2484.   FOR y&=1 TO 10
  2485.     FOR x&=1 TO 15
  2486.       GOSUB fillsquare(y&,x&)
  2487.       GOSUB fillsquare(21-y&,x&)
  2488.       GOSUB fillsquare(y&,31-x&)
  2489.       GOSUB fillsquare(21-y&,31-x&)
  2490.     NEXT x&
  2491.   NEXT y&
  2492. RETURN
  2493. PROCEDURE fillsquare(f&,g&)
  2494.   IF b&(f&,g&)<>0
  2495.     PUT g&*8+xb&,f&*8+yb&,mini$(b&(f&,g&))
  2496.   ENDIF
  2497.   IF b&(f&,g&)=27 OR b&(f&,g&)=31
  2498.     FOR h&=1 TO 26
  2499.       IF (f&=tele&(h&,1) AND g&=tele&(h&,2)) OR (f&=tele&(h&,3) AND g&=tele&(h&,4))
  2500.         IF b&(f&,g&)=31
  2501.           COLOR 3
  2502.         ENDIF
  2503.         TEXT g&*8+xb&,f&*8+yb&+6,CHR$(h&+64)
  2504.         COLOR 1
  2505.       ENDIF
  2506.     NEXT h&
  2507.   ENDIF
  2508. RETURN
  2509. PROCEDURE encode
  2510.   encoded$=""
  2511.   k%=0
  2512.   ' loop to generate constant for randomization from password.
  2513.   FOR f&=1 TO LEN(default$)
  2514.     j%=ASC(MID$(default$,f&,1))
  2515.     ADD k%,j%
  2516.     MUL k%,j%
  2517.     k%=k% MOD 256
  2518.   NEXT f&
  2519.   FOR f&=1 TO LEN(default$)
  2520.     j%=ASC(MID$(default$,f&,1))
  2521.     ADD j%,k%*f&
  2522.     j%=j% MOD 94
  2523.     ADD j%,33
  2524.     IF j%=ASC("/") OR j%=ASC(":") ! These confuse filing system
  2525.       INC j%
  2526.     ENDIF
  2527.     encoded$=encoded$+CHR$(j%)
  2528.   NEXT f&
  2529. RETURN
  2530. PROCEDURE editlevel
  2531.   GOSUB drawlevel
  2532.   lastsel&=0
  2533.   exit!=FALSE
  2534.   REPEAT
  2535.     REPEAT
  2536.       GOSUB mouse
  2537.       ink$=UPPER$(INKEY$)
  2538.       joy&=STICK(1)
  2539.       IF ink$=CHR$(13) OR STRIG(1)
  2540.         b&=1
  2541.       ENDIF
  2542.       IF LEFT$(ink$,1)=CHR$(155)
  2543.         SELECT RIGHT$(ink$,1) ! Detect cursors
  2544.         CASE "A"
  2545.           joy&=1
  2546.         CASE "B"
  2547.           joy&=2
  2548.         CASE "C"
  2549.           joy&=8
  2550.         CASE "D"
  2551.           joy&=4
  2552.         ENDSELECT
  2553.       ENDIF
  2554.       IF joy& OR ink$=" " OR (ink$>="A" AND ink$<="[")
  2555.         oldsel&=select&
  2556.         IF ink$=" "
  2557.           ADD select&,tog&
  2558.           SWAP select&,lastsel&
  2559.           IF select&=0 AND tog&<>0
  2560.             GOSUB flip
  2561.             oldsel&=0
  2562.           ENDIF
  2563.           SUB select&,tog&
  2564.         ELSE
  2565.           SELECT joy&
  2566.           CASE 1
  2567.             DEC select&
  2568.           CASE 2
  2569.             INC select&
  2570.           CASE 8
  2571.             ADD select&,8
  2572.           CASE 4
  2573.             SUB select&,8
  2574.           ENDSELECT
  2575.         ENDIF
  2576.         IF select&<0 AND tog&<>0
  2577.           ADD select&,28
  2578.           GOSUB flip
  2579.           oldsel&=0
  2580.         ENDIF
  2581.         IF select&>27 AND tog&=0
  2582.           SUB select&,28
  2583.           GOSUB flip
  2584.           oldsel&=0
  2585.         ENDIF
  2586.         IF select&<0 OR select&>27 OR select&>num&-tog&
  2587.           select&=oldsel&
  2588.         ENDIF
  2589.         IF ink$=>"A" AND ink$<="["
  2590.           IF tog&=0
  2591.             select&=27
  2592.           ELSE
  2593.             select&=3
  2594.           ENDIF
  2595.         ENDIF
  2596.         IF select&<>oldsel&
  2597.           COLOR 1
  2598.           GOSUB box(oldsel&)
  2599.           COLOR 2
  2600.           GOSUB box(select&)
  2601.           GOSUB putbig
  2602.         ENDIF
  2603.         REPEAT
  2604.         UNTIL STICK(1)=0
  2605.       ENDIF
  2606.       IF ink$=>"A" AND ink$=<"["
  2607.         tele&=ASC(ink$)-64
  2608.         GOSUB teleletter
  2609.       ENDIF
  2610.       IF LEFT$(ink$,1)=CHR$(155) AND RIGHT$(ink$,1)=CHR$(126)
  2611.         fn&=ASC(MID$(ink$,2,1))-47
  2612.         IF fn&=10
  2613.           INC fn&
  2614.         ENDIF
  2615.         b&=1
  2616.         x&=255-xb&
  2617.         y&=(fn&*14)-4-yb&
  2618.       ENDIF
  2619.       IF ink$=CHR$(13) OR STRIG(1) ! Test
  2620.         b&=1
  2621.         x&=255-xb&
  2622.         y&=(2*14)-4-yb&
  2623.       ENDIF
  2624.       IF b&=2
  2625.         GOSUB flip
  2626.         REPEAT
  2627.         UNTIL MOUSEK<>2
  2628.       ENDIF
  2629.       IF b&=3 AND debug!=TRUE
  2630.         GOSUB listlevels
  2631.       ENDIF
  2632.       IF lastsel&<>0 AND select&+tog&<>0
  2633.         lastsel&=0
  2634.       ENDIF
  2635.     UNTIL b&=1
  2636.     ADD y&,yb&
  2637.     ADD x&,xb&
  2638.     IF y&<21*8 AND x&<31*8
  2639.       g&=x& DIV 8
  2640.       f&=y& DIV 8
  2641.       SELECT line&
  2642.       CASE 0
  2643.         GOSUB changesquare
  2644.       CASE 1
  2645.         IF linex&<>-1 AND liney&<>-1
  2646.           GOSUB resetline
  2647.           toy&=f&
  2648.           tox&=g&
  2649.           IF toy&<liney&
  2650.             SWAP liney&,toy&
  2651.           ENDIF
  2652.           IF tox&<linex&
  2653.             SWAP tox&,linex&
  2654.           ENDIF
  2655.           FOR f&=liney& TO toy&
  2656.             FOR g&=linex& TO tox&
  2657.               GOSUB changesquare
  2658.               IF INKEY$=" "
  2659.                 g&=tox&
  2660.                 f&=toy&
  2661.               ENDIF
  2662.             NEXT g&
  2663.           NEXT f&
  2664.           liney&=-1
  2665.           linex&=-1
  2666.         ELSE
  2667.           liney&=f&
  2668.           linex&=g&
  2669.           COLOR 1
  2670.           BOX g&*8+xb&,f&*8+yb&,g&*8+xb&+7,f&*8+yb&+7
  2671.         ENDIF
  2672.         REPEAT
  2673.         UNTIL MOUSEK=0
  2674.       CASE 2
  2675.         jab|=b&(f&,g&)
  2676.         IF select&+tog&<>jab| AND select&+tog&<>2 AND select&+tog&<>27 AND select&+tog&<>31
  2677.           ARRAYFILL ob&(),0
  2678.           level&=0
  2679.           GOSUB recurse(f&,g&)
  2680.         ENDIF
  2681.       CASE 3
  2682.         IF linex&<>-1 AND liney&<>-1
  2683.           GOSUB resetline
  2684.           toy&=f&
  2685.           tox&=g&
  2686.           IF toy&<liney&
  2687.             SWAP liney&,toy&
  2688.           ENDIF
  2689.           IF tox&<linex&
  2690.             SWAP tox&,linex&
  2691.           ENDIF
  2692.           FOR g&=linex& TO tox&
  2693.             FOR f&=liney& TO toy&
  2694.               gt|(f&-liney&,g&-linex&)=b&(f&,g&)
  2695.             NEXT f&
  2696.           NEXT g&
  2697.           gty&=toy&-liney&
  2698.           gtx&=tox&-linex&
  2699.           liney&=-1
  2700.           linex&=-1
  2701.           COLOR 1
  2702.           TEXT xb&+257,yb&+11*14+5,"Put Area"
  2703.           line&=4
  2704.         ELSE
  2705.           liney&=f&
  2706.           linex&=g&
  2707.           COLOR 1
  2708.           BOX g&*8+xb&,f&*8+yb&,g&*8+xb&+7,f&*8+yb&+7
  2709.         ENDIF
  2710.         REPEAT
  2711.         UNTIL MOUSEK=0
  2712.       CASE 4
  2713.         toy&=f&
  2714.         tox&=g&
  2715.         oldsel&=select&
  2716.         FOR f&=toy& TO toy&+gty&
  2717.           FOR g&=tox& TO tox&+gtx&
  2718.             IF f&>0 AND f&<21 AND g&>0 AND g&<31
  2719.               select&=gt|(f&-toy&,g&-tox&)-tog&
  2720.               GOSUB changesquare
  2721.             ENDIF
  2722.           NEXT g&
  2723.         NEXT f&
  2724.         select&=oldsel&
  2725.       ENDSELECT
  2726.     ENDIF
  2727.     IF y&>21*8 AND x&<31*8
  2728.       xx&=(x&-2) DIV 54
  2729.       yy&=(y&-171) DIV 12
  2730.       news&=yy&+xx&*8
  2731.       IF news&<>select& AND news&<=(num&-tog&) AND news&<=27
  2732.         COLOR 1
  2733.         GOSUB box(select&)
  2734.         select&=news&
  2735.         COLOR 2
  2736.         GOSUB box(select&)
  2737.         GOSUB putbig
  2738.       ENDIF
  2739.     ENDIF
  2740.     IF x&=>270 AND y&=>230-kon& AND x&<=344 AND y&<=242-kon&
  2741.       COLOR 2
  2742.       BOX xb&+270,yb&-kon&+230,xb&+344,yb&-kon&+242
  2743.       PRINT AT(36,30+kon&);
  2744.       FORM INPUT 8 AS next$
  2745.       next$=UPPER$(next$)
  2746.       PRINT AT(36,30+kon&);SPACE$(8)
  2747.       PRINT AT(36,30+kon&);next$
  2748.       COLOR 1
  2749.       BOX xb&+270,yb&-kon&+230,xb&+344,yb&-kon&+242
  2750.     ENDIF
  2751.     IF x&=>270 AND y&=>214-kon& AND x&<=344 AND y&<=226-kon&
  2752.       COLOR 2
  2753.       BOX xb&+270,yb&-kon&+214,xb&+344,yb&-kon&+226
  2754.       PRINT AT(36,28+kon&);
  2755.       old$=default$
  2756.       FORM INPUT 8 AS default$
  2757.       default$=UPPER$(default$)
  2758.       GOSUB encode
  2759.       IF old$<>default$
  2760.         IF EXIST(path$+encoded$+".PLASMA")
  2761.           GET 0,0,width& DIV 2,height&,get1$
  2762.           GET width& DIV 2,0,width&,height&,get2$
  2763.           GOSUB fade(0)
  2764.           CLEARW #sit&
  2765.           x$="The level "+default$+" already"
  2766.           GOSUB text((height&/2)-42,1)
  2767.           x$="exists on the disk. Do you really"
  2768.           GOSUB text((height&/2)-32,1)
  2769.           x$="want to use that name?"
  2770.           GOSUB text((height&/2)-22,1)
  2771.           GOSUB yesno
  2772.           PUT 0,0,get1$
  2773.           PUT width& DIV 2,0,get2$
  2774.           IF yesno&=2
  2775.             default$=old$
  2776.             GOSUB encode
  2777.           ENDIF
  2778.           GOSUB fade(15)
  2779.         ENDIF
  2780.       ENDIF
  2781.       PRINT AT(36,28+kon&);SPACE$(8)
  2782.       PRINT AT(36,28+kon&);default$
  2783.       PRINT AT(36,26+kon&);SPACE$(8)
  2784.       PRINT AT(36,26+kon&);encoded$
  2785.       COLOR 1
  2786.       BOX xb&+270,yb&-kon&+214,xb&+344,yb&-kon&+226
  2787.     ENDIF
  2788.     IF x&=>302 AND y&=>246-kon& AND x&<=344 AND y&<=258-kon&
  2789.       COLOR 2
  2790.       BOX xb&+302,yb&-kon&+246,xb&+344,yb&-kon&+258
  2791.       PRINT AT(40,32+kon&);
  2792.       need$=STR$(needed&)
  2793.       FORM INPUT 3 AS need$
  2794.       needed&=VAL(need$)
  2795.       IF UPPER$(need$)="MAX"
  2796.         FOR f&=1 TO 20
  2797.           FOR g&=1 TO 30
  2798.             IF s!(b&(f&,g&),8)
  2799.               INC needed&
  2800.             ENDIF
  2801.           NEXT g&
  2802.         NEXT f&
  2803.       ENDIF
  2804.       PRINT AT(40,32+kon&);"   ";
  2805.       PRINT AT(40,32+kon&);needed&
  2806.       COLOR 1
  2807.       BOX xb&+302,yb&-kon&+246,xb&+344,yb&-kon&+258
  2808.     ENDIF
  2809.     IF x&>254
  2810.       GOSUB clickbuts
  2811.     ENDIF
  2812.   UNTIL exit!
  2813. RETURN
  2814. PROCEDURE recurse(f&,g&)
  2815.   LOCAL a|,b|
  2816.   INC level&
  2817.   a|=f&
  2818.   b|=g&
  2819.   old&=b&(f&,g&)
  2820.   GOSUB changesquare
  2821.   IF a|>1
  2822.     IF ob&(a|-1,b|)=0
  2823.       ob&(a|-1,b|)=level&
  2824.     ENDIF
  2825.   ENDIF
  2826.   IF a|<20
  2827.     IF ob&(a|+1,b|)=0
  2828.       ob&(a|+1,b|)=level&
  2829.     ENDIF
  2830.   ENDIF
  2831.   IF b|>1
  2832.     IF ob&(a|,b|-1)=0
  2833.       ob&(a|,b|-1)=level&
  2834.     ENDIF
  2835.   ENDIF
  2836.   IF b|<30
  2837.     IF ob&(a|,b|+1)=0
  2838.       ob&(a|,b|+1)=level&
  2839.     ENDIF
  2840.   ENDIF
  2841.   IF b&(f&,g&)<>old&
  2842.     IF a|>1
  2843.       IF b&(a|-1,b|)=jab| AND ob&(a|-1,b|)=level&
  2844.         GOSUB recurse(a|-1,b|)
  2845.       ENDIF
  2846.     ENDIF
  2847.     IF a|<20
  2848.       IF b&(a|+1,b|)=jab| AND ob&(a|+1,b|)=level&
  2849.         GOSUB recurse(a|+1,b|)
  2850.       ENDIF
  2851.     ENDIF
  2852.     IF b|>1
  2853.       IF b&(a|,b|-1)=jab| AND ob&(a|,b|-1)=level&
  2854.         GOSUB recurse(a|,b|-1)
  2855.       ENDIF
  2856.     ENDIF
  2857.     IF b|<30
  2858.       IF b&(a|,b|+1)=jab| AND ob&(a|,b|+1)=level&
  2859.         GOSUB recurse(a|,b|+1)
  2860.       ENDIF
  2861.     ENDIF
  2862.   ENDIF
  2863.   DEC level&
  2864. RETURN
  2865. PROCEDURE icons
  2866.   x&=0
  2867.   y&=-1
  2868.   COLOR 1
  2869.   FOR f&=tog& TO tog&+27
  2870.     INC y&
  2871.     IF y&>7
  2872.       INC x&
  2873.       y&=0
  2874.     ENDIF
  2875.     FOR g&=0 TO 5
  2876.       PUT xb&+x&*54+g&*8+8,yb&+172+y&*12,mini$(f&)
  2877.     NEXT g&
  2878.     GOSUB box(f&-tog&)
  2879.     EXIT IF f&=num&
  2880.   NEXT f&
  2881. RETURN
  2882. PROCEDURE flip
  2883.   tog&=28-tog&
  2884.   IF tog&=0
  2885.     PUT xb&,yb&+171,tog0$
  2886.   ELSE
  2887.     PUT xb&,yb&+171,tog1$
  2888.   ENDIF
  2889.   IF select&>(num&-tog&)
  2890.     select&=num&-tog&
  2891.   ENDIF
  2892.   COLOR 2
  2893.   GOSUB box(select&)
  2894.   COLOR 1
  2895.   GOSUB teleletter
  2896.   GOSUB putbig
  2897. RETURN
  2898. PROCEDURE putbig
  2899.   PUT xb&+174,yb&+220,a$(select&+tog&)
  2900.   PRINT AT(30,23+kon&);SPC(15)
  2901.   PRINT AT(30,23+kon&);pr$(select&+tog&,2)
  2902. RETURN
  2903. PROCEDURE box(n&)
  2904.   xplot&=xb&+(n& DIV 8)*54+8
  2905.   yplot&=yb&+172+(n& MOD 8)*12-1
  2906.   BOX xplot&,yplot&,xplot&+6*8,yplot&+10
  2907. RETURN
  2908. PROCEDURE buttons
  2909.   RESTORE butts
  2910.   FOR f&=1 TO 11
  2911.     READ read$
  2912.     TEXT xb&+257,yb&+f&*14+5,read$
  2913.     IF f&=3
  2914.       TEXT xb&+256+8*5,yb&+f&*14+5,"Load"
  2915.     ENDIF
  2916.     IF f&=8
  2917.       TEXT xb&+256+8*8,yb&+f&*14+5,"Y"
  2918.     ENDIF
  2919.     GOSUB butbox(f&)
  2920.   NEXT f&
  2921.   butts:
  2922.   DATA "","Test","Save ","Clear"
  2923.   DATA "Max Diam.","Delete",""
  2924.   DATA "X Flip  ","Exit","Specials"
  2925.   DATA "Draw"
  2926.   SELECT map&
  2927.   CASE 0
  2928.     x$="Map Off  "
  2929.   CASE 1
  2930.     x$="Map On   "
  2931.   CASE 2
  2932.     x$="Map Half "
  2933.   ENDSELECT
  2934.   TEXT xb&+257,yb&+1*14+5,x$
  2935.   SELECT gravity&
  2936.   CASE -1
  2937.     x$="Grav Up  "
  2938.   CASE 0
  2939.     x$="Grav Off "
  2940.   CASE 1
  2941.     x$="Grav Down"
  2942.   ENDSELECT
  2943.   TEXT xb&+257,yb&+7*14+5,x$
  2944. RETURN
  2945. PROCEDURE butbox(n&)
  2946.   BOX xb&+255,yb&+n&*14-4,xb&+329,yb&+n&*14+10
  2947. RETURN
  2948. PROCEDURE changesquare
  2949.   ADD select&,tog&
  2950.   doit!=FALSE
  2951.   IF f&>1 AND f&<20 AND g&>1 AND g&<30 ! check it's inside
  2952.     doit!=TRUE
  2953.   ENDIF
  2954.   IF (f&=1 OR f&=20 OR g&=1 OR g&=30) AND (select&=4 OR select&=8 OR select&=9 OR select&=11 OR select&=12 OR (select&>22 AND select&<27) OR select&=29 OR select&=30 OR (select&>=32 AND select&<=40))
  2955.     doit!=TRUE ! You can overwrite outer wall with curved wall, si tu veux. (And invisible walls and...)
  2956.   ENDIF
  2957.   IF f&<1 OR f&>20 OR g&<1 OR g&>30 ! check it's not outside
  2958.     doit!=FALSE
  2959.   ENDIF
  2960.   IF doit! AND (f&<>many& OR g&<>manx&)
  2961.     PUT g&*8+xb&,f&*8+yb&,mini$(select&)
  2962.     IF b&(f&,g&)=27 OR b&(f&,g&)=31 ! Teleport erased
  2963.       FOR h&=1 TO 26
  2964.         IF (f&=tele&(h&,1) AND g&=tele&(h&,2))
  2965.           tele&(h&,1)=0
  2966.           tele&(h&,2)=0
  2967.           EXIT IF 1
  2968.         ELSE IF (f&=tele&(h&,3) AND g&=tele&(h&,4))
  2969.           tele&(h&,3)=0
  2970.           tele&(h&,4)=0
  2971.           EXIT IF 1
  2972.         ENDIF
  2973.       NEXT h&
  2974.     ENDIF
  2975.     b&(f&,g&)=select&
  2976.     IF select&=27 OR select&=31 ! Teleport placed
  2977.       IF b&(tele&(tele&,1),tele&(tele&,2))<>select& AND tele&(tele&,1)<>0 AND tele&(tele&,2)<>0
  2978.         PUT tele&(tele&,2)*8+xb&,tele&(tele&,1)*8+yb&,mini$(0)
  2979.         b&(tele&(tele&,1),tele&(tele&,2))=0
  2980.         tele&(tele&,1)=0
  2981.         tele&(tele&,2)=0
  2982.       ENDIF
  2983.       IF b&(tele&(tele&,3),tele&(tele&,4))<>select& AND tele&(tele&,3)<>0 AND tele&(tele&,4)<>0
  2984.         PUT tele&(tele&,4)*8+xb&,tele&(tele&,3)*8+yb&,mini$(0)
  2985.         b&(tele&(tele&,3),tele&(tele&,4))=0
  2986.         tele&(tele&,3)=0
  2987.         tele&(tele&,4)=0
  2988.       ENDIF
  2989.       IF tele&(tele&,1)=0 AND tele&(tele&,2)=0
  2990.         tele&(tele&,1)=f&
  2991.         tele&(tele&,2)=g&
  2992.       ELSE IF tele&(tele&,3)=0 AND tele&(tele&,4)=0
  2993.         tele&(tele&,3)=f&
  2994.         tele&(tele&,4)=g&
  2995.       ELSE
  2996.         PUT tele&(tele&,2)*8+xb&,tele&(tele&,1)*8+yb&,mini$(0)
  2997.         b&(tele&(tele&,1),tele&(tele&,2))=0
  2998.         tele&(tele&,1)=tele&(tele&,3)
  2999.         tele&(tele&,2)=tele&(tele&,4)
  3000.         tele&(tele&,3)=f&
  3001.         tele&(tele&,4)=g&
  3002.       ENDIF
  3003.       COLOR 1
  3004.       IF select&=31
  3005.         COLOR 3
  3006.       ENDIF
  3007.       TEXT g&*8+xb&,f&*8+yb&+6,CHR$(tele&+64)
  3008.       COLOR 1
  3009.     ENDIF
  3010.     IF select&=2
  3011.       PUT manx&*8+xb&,many&*8+yb&,mini$(0)
  3012.       b&(many&,manx&)=0
  3013.       manx&=g&
  3014.       many&=f&
  3015.     ENDIF
  3016.   ENDIF
  3017.   SUB select&,tog&
  3018. RETURN
  3019. PROCEDURE clickbuts
  3020.   yy&=(y&+4) DIV 14
  3021.   IF (yy&>0 AND yy&<3) OR (yy&>3 AND yy&<8) OR (yy&>=9 AND yy&<=11)
  3022.     COLOR 2
  3023.     GOSUB butbox(yy&)
  3024.   ENDIF
  3025.   SELECT yy&
  3026.   CASE 1
  3027.     INC map&
  3028.     IF map&=3
  3029.       map&=0
  3030.     ENDIF
  3031.     SELECT map&
  3032.     CASE 0
  3033.       x$="Map Off  "
  3034.     CASE 1
  3035.       x$="Map On   "
  3036.     CASE 2
  3037.       x$="Map Half "
  3038.     ENDSELECT
  3039.     COLOR 1
  3040.     TEXT xb&+257,yb&+1*14+5,x$
  3041.   CASE 2
  3042.     GOSUB fade(0)
  3043.     GET 0,0,width& DIV 2,height&,get1$
  3044.     GET width& DIV 2,0,width&,height&,get2$
  3045.     GOSUB backplay
  3046.     autoload$=""
  3047.     PUT 0,0,get1$
  3048.     PUT width& DIV 2,0,get2$
  3049.     GOSUB fade(15)
  3050.   CASE 3
  3051.     COLOR 2
  3052.     IF x&<292
  3053.       ' Save
  3054.       BOX xb&+255,yb&+3*14-4,xb&+292,yb&+3*14+10
  3055.       GOSUB savelevel
  3056.       COLOR 1
  3057.       BOX xb&+255,yb&+3*14-4,xb&+292,yb&+3*14+10
  3058.     ELSE
  3059.       ' Load
  3060.       BOX xb&+292,yb&+3*14-4,xb&+329,yb&+3*14+10
  3061.       GET 0,0,width& DIV 2,height&,get1$
  3062.       GET width& DIV 2,0,width&,height&,get2$
  3063.       GOSUB fade(0)
  3064.       CLEARW #sit&
  3065.       x$="Hey! Have you saved it? Do you"
  3066.       GOSUB text((height&/2)-32,1)
  3067.       x$="really want to load a new level?"
  3068.       GOSUB text((height&/2)-22,1)
  3069.       x$="Remember, the next password is "+next$+"."
  3070.       GOSUB text((height&/2)+42,1)
  3071.       GOSUB yesno
  3072.       IF yesno&=2
  3073.         PUT 0,0,get1$
  3074.         PUT width& DIV 2,0,get2$
  3075.         GOSUB fade(15)
  3076.         COLOR 1
  3077.         BOX xb&+292,yb&+3*14-4,xb&+329,yb&+3*14+10
  3078.       ELSE
  3079.         default$=next$
  3080.         autoload!=TRUE
  3081.         exit!=TRUE
  3082.       ENDIF
  3083.     ENDIF
  3084.   CASE 4
  3085.     GET 0,0,width& DIV 2,height&,get1$
  3086.     GET width& DIV 2,0,width&,height&,get2$
  3087.     GOSUB fade(0)
  3088.     CLEARW #sit&
  3089.     x$="Careful! Do you really"
  3090.     GOSUB text((height&/2)-32,1)
  3091.     x$="want to clear the level?"
  3092.     GOSUB text((height&/2)-22,1)
  3093.     GOSUB yesno
  3094.     PUT 0,0,get1$
  3095.     PUT width& DIV 2,0,get2$
  3096.     IF yesno&=1
  3097.       FOR f&=2 TO 29
  3098.         FOR g&=2 TO 19
  3099.           b&(g&,f&)=0
  3100.         NEXT g&
  3101.       NEXT f&
  3102.       ARRAYFILL tele&(),0
  3103.       b&(2,2)=2
  3104.       manx&=2
  3105.       many&=2
  3106.       DEFFILL 0
  3107.       PBOX xb&+16,yb&+16,xb&+239,yb&+159
  3108.       PUT manx&*8+xb&,many&*8+yb&,mini$(2)
  3109.     ENDIF
  3110.     GOSUB fade(15)
  3111.   CASE 11
  3112.     INC line&
  3113.     IF line&=5
  3114.       line&=0
  3115.     ENDIF
  3116.     IF line&=4 AND gtx&=0 AND gty&=0
  3117.       line&=0
  3118.     ENDIF
  3119.     SELECT line&
  3120.     CASE 0
  3121.       x$="Draw     "
  3122.     CASE 1
  3123.       x$="Box/Line "
  3124.     CASE 2
  3125.       x$="Fill     "
  3126.     CASE 3
  3127.       x$="Get Area "
  3128.     CASE 4
  3129.       x$="Put Area "
  3130.     ENDSELECT
  3131.     COLOR 1
  3132.     TEXT xb&+257,yb&+11*14+5,x$
  3133.     GOSUB resetline
  3134.     liney&=-1
  3135.     linex&=-1
  3136.   CASE 5
  3137.     GOSUB maxdiamonds
  3138.   CASE 6
  3139.     GET 0,0,width& DIV 2,height&,get1$
  3140.     GET width& DIV 2,0,width&,height&,get2$
  3141.     GOSUB fade(0)
  3142.     CLEARW #sit&
  3143.     x$="Careful! Do you definately want"
  3144.     GOSUB text((height&/2)-42,1)
  3145.     x$="to permanently erase this level"
  3146.     GOSUB text((height&/2)-32,1)
  3147.     x$="from disk?"
  3148.     GOSUB text((height&/2)-22,1)
  3149.     GOSUB yesno
  3150.     GOSUB encode
  3151.     IF yesno&=1
  3152.       file$=path$+encoded$+".PLASMA"
  3153.       IF NOT (EXIST(file$))
  3154.         x$="That level is not on the disk."
  3155.         GOSUB text((height&/2),1)
  3156.         GOSUB fade(15)
  3157.         GOSUB pause
  3158.         GOSUB fade(0)
  3159.       ELSE
  3160.         KILL file$
  3161.       ENDIF
  3162.     ENDIF
  3163.     PUT 0,0,get1$
  3164.     PUT width& DIV 2,0,get2$
  3165.     GOSUB fade(15)
  3166.   CASE 7
  3167.     INC gravity&
  3168.     IF gravity&=2
  3169.       gravity&=-1
  3170.     ENDIF
  3171.     SELECT gravity&
  3172.     CASE -1
  3173.       x$="Grav Up  "
  3174.     CASE 0
  3175.       x$="Grav Off "
  3176.     CASE 1
  3177.       x$="Grav Down"
  3178.     ENDSELECT
  3179.     COLOR 1
  3180.     TEXT xb&+257,yb&+7*14+5,x$
  3181.   CASE 8
  3182.     IF gtx&=0 OR gty&=0
  3183.       ~DisplayBeep(SCREEN(2))
  3184.     ELSE
  3185.       COLOR 2
  3186.       IF x&<292
  3187.         ' X Flip
  3188.         BOX xb&+255,yb&+8*14-4,xb&+266,yb&+8*14+10
  3189.         FOR f&=0 TO gty&
  3190.           FOR g&=0 TO gtx& DIV 2
  3191.             GOSUB xcomp
  3192.             SWAP gt|(f&,g&),gt|(f&,gtx&-g&)
  3193.             IF g&<>gtx&-g&
  3194.               GOSUB xcomp
  3195.             ENDIF
  3196.           NEXT g&
  3197.         NEXT f&
  3198.         COLOR 1
  3199.         BOX xb&+255,yb&+8*14-4,xb&+266,yb&+8*14+10
  3200.       ELSE
  3201.         ' Y Flip
  3202.         BOX xb&+318,yb&+8*14-4,xb&+329,yb&+8*14+10
  3203.         FOR f&=0 TO gty& DIV 2
  3204.           FOR g&=0 TO gtx&
  3205.             GOSUB ycomp
  3206.             SWAP gt|(f&,g&),gt|(gty&-f&,g&)
  3207.             IF f&<>gty&-f&
  3208.               GOSUB ycomp
  3209.             ENDIF
  3210.           NEXT g&
  3211.         NEXT f&
  3212.         COLOR 1
  3213.         BOX xb&+318,yb&+8*14-4,xb&+329,yb&+8*14+10
  3214.       ENDIF
  3215.     ENDIF
  3216.   CASE 9
  3217.     GET 0,0,width& DIV 2,height&,get1$
  3218.     GET width& DIV 2,0,width&,height&,get2$
  3219.     GOSUB fade(0)
  3220.     CLEARW #sit&
  3221.     x$="Hey! Have you saved it? Do you"
  3222.     GOSUB text((height&/2)-32,1)
  3223.     x$="really want to leave the editor? "
  3224.     GOSUB text((height&/2)-22,1)
  3225.     x$="Remember, the next password is "+next$+"."
  3226.     GOSUB text((height&/2)+42,1)
  3227.     GOSUB yesno
  3228.     IF yesno&=2
  3229.       PUT 0,0,get1$
  3230.       PUT width& DIV 2,0,get2$
  3231.       GOSUB fade(15)
  3232.     ELSE
  3233.       exit!=TRUE
  3234.     ENDIF
  3235.   CASE 10
  3236.     GOSUB specs
  3237.   ENDSELECT
  3238.   REPEAT
  3239.   UNTIL MOUSEK=0
  3240.   IF ((yy&>0 AND yy&<3) OR (yy&>3 AND yy&<8) OR (yy&=>9 AND yy&<=11)) AND exit!=FALSE
  3241.     COLOR 1
  3242.     GOSUB butbox(yy&)
  3243.   ENDIF
  3244.   IF exit!=FALSE
  3245.     COLOR 2
  3246.   ENDIF
  3247. RETURN
  3248. PROCEDURE maxdiamonds
  3249.   needed&=0
  3250.   FOR f&=1 TO 20
  3251.     FOR g&=1 TO 30
  3252.       IF s!(b&(f&,g&),8)
  3253.         INC needed&
  3254.       ENDIF
  3255.     NEXT g&
  3256.   NEXT f&
  3257.   PRINT AT(40,32+kon&);"   ";
  3258.   PRINT AT(40,32+kon&);needed&
  3259. RETURN
  3260. PROCEDURE ycomp
  3261.   SELECT gt|(f&,g&)
  3262.   CASE 8
  3263.     ADD gt|(f&,g&),3
  3264.   CASE 9
  3265.     ADD gt|(f&,g&),3
  3266.   CASE 12
  3267.     SUB gt|(f&,g&),3
  3268.   CASE 11
  3269.     SUB gt|(f&,g&),3
  3270.   CASE 23,24
  3271.     gt|(f&,g&)=47-gt|(f&,g&)
  3272.   CASE 32,34
  3273.     gt|(f&,g&)=66-gt|(f&,g&)
  3274.   CASE 33,35
  3275.     gt|(f&,g&)=68-gt|(f&,g&)
  3276.   CASE 36,38
  3277.     gt|(f&,g&)=74-gt|(f&,g&)
  3278.   CASE 41,43
  3279.     gt|(f&,g&)=84-gt|(f&,g&)
  3280.   CASE 48,50
  3281.     gt|(f&,g&)=98-gt|(f&,g&)
  3282.   ENDSELECT
  3283. RETURN
  3284. PROCEDURE xcomp
  3285.   SELECT gt|(f&,g&)
  3286.   CASE 8
  3287.     INC gt|(f&,g&)
  3288.   CASE 9
  3289.     DEC gt|(f&,g&)
  3290.   CASE 12
  3291.     DEC gt|(f&,g&)
  3292.   CASE 11
  3293.     INC gt|(f&,g&)
  3294.   CASE 25,26
  3295.     gt|(f&,g&)=51-gt|(f&,g&)
  3296.   CASE 21,22
  3297.     gt|(f&,g&)=43-gt|(f&,g&)
  3298.   CASE 32,33
  3299.     gt|(f&,g&)=65-gt|(f&,g&)
  3300.   CASE 34,35
  3301.     gt|(f&,g&)=69-gt|(f&,g&)
  3302.   CASE 37,39
  3303.     gt|(f&,g&)=76-gt|(f&,g&)
  3304.   CASE 42,44
  3305.     gt|(f&,g&)=86-gt|(f&,g&)
  3306.   CASE 45,46
  3307.     gt|(f&,g&)=91-gt|(f&,g&)
  3308.   CASE 47,49
  3309.     gt|(f&,g&)=96-gt|(f&,g&)
  3310.   ENDSELECT
  3311. RETURN
  3312. PROCEDURE resetline
  3313.   IF linex&<>-1 AND liney&<>-1
  3314.     PUT linex&*8+xb&,liney&*8+yb&,mini$(b&(liney&,linex&))
  3315.     IF b&(liney&,linex&)=27 OR b&(liney&,linex&)=31
  3316.       FOR h&=1 TO 26
  3317.         IF (liney&=tele&(h&,1) AND linex&=tele&(h&,2)) OR (liney&=tele&(h&,3) AND linex&=tele&(h&,4))
  3318.           IF b&(linex&,liney&)=31
  3319.             COLOR 3
  3320.           ENDIF
  3321.           TEXT linex&*8+xb&,liney&*8+yb&+6,CHR$(h&+64)
  3322.           COLOR 1
  3323.         ENDIF
  3324.       NEXT h&
  3325.     ENDIF
  3326.   ENDIF
  3327. RETURN
  3328. PROCEDURE teleletter
  3329.   FOR g&=1 TO 4 STEP 3
  3330.     IF tog&=0
  3331.       COLOR 1
  3332.       TEXT xb&+3*54+g&*8+8,yb&+172+3*12+6,CHR$(tele&+64)
  3333.     ELSE
  3334.       COLOR 3
  3335.       TEXT xb&+g&*8+8,yb&+172+3*12+6,CHR$(tele&+64)
  3336.     ENDIF
  3337.   NEXT g&
  3338. RETURN
  3339. PROCEDURE listlevels ! DEBUG
  3340.   GOSUB fade(0)
  3341.   GET 0,0,width& DIV 2,height&,get1$
  3342.   GET width& DIV 2,0,width&,height&,get2$
  3343.   CLEARW #sit&
  3344.   COLOR 1
  3345.   TEXT xb&+5,yb&+8,"List of Levels.    Free Memory: "+STR$(FRE(0))
  3346.   TEXT xb&+5,yb&+24,"NAME      MAP   GRAVITY  NEEDED  AUTHOR"
  3347.   GOSUB fade(15)
  3348.   '
  3349.   numlev&=0
  3350.   totdia&=0
  3351.   vert&=yb&+36
  3352.   olddefault$=default$
  3353.   DO
  3354.     EXIT IF INKEY$<>""
  3355.     GOSUB encode
  3356.     file$=path$+encoded$+".PLASMA"
  3357.     '
  3358.     IF NOT EXIST(file$)
  3359.       TEXT xb&+5,vert&+5,"Not Found: "+default$
  3360.       EXIT IF 1
  3361.     ENDIF
  3362.     '
  3363.     $U
  3364.     OPEN "i",#1,file$
  3365.     $U
  3366.     FRONTS 2
  3367.     void$=INPUT$(600,#1)
  3368.     oneed&=CVI(INPUT$(2,#1))
  3369.     omap&=INP(#1)
  3370.     len&=INP(#1)
  3371.     void$=""
  3372.     FOR f&=1 TO len&
  3373.       void$=void$+CHR$(INP(#1)-87)
  3374.     NEXT f&
  3375.     IF NOT EOF(#1)
  3376.       gravity&=INP(#1)-1
  3377.     ELSE
  3378.       gravity&=1
  3379.     ENDIF
  3380.     IF NOT EOF(#1)
  3381.       LINE INPUT #1,oauthor$
  3382.     ELSE
  3383.       oauthor$="Unknown"
  3384.     ENDIF
  3385.     CLOSE #1
  3386.     '
  3387.     INC numlev&
  3388.     ADD totdia&,oneed&
  3389.     '
  3390.     SWAP void$,default$
  3391.     void$=void$+SPACE$(8-LEN(void$))
  3392.     SELECT omap&
  3393.     CASE 1
  3394.       void$=void$+"  ON  "
  3395.     CASE 0
  3396.       void$=void$+"  OFF "
  3397.     CASE 2
  3398.       void$=void$+"  HALF"
  3399.     ENDSELECT
  3400.     SELECT gravity&
  3401.     CASE 1
  3402.       void$=void$+"  DOWN   "
  3403.     CASE -1
  3404.       void$=void$+"  UP     "
  3405.     CASE 0
  3406.       void$=void$+"  OFF    "
  3407.     ENDSELECT
  3408.     void$=void$+"  "+STR$(oneed&,6)+"  "+oauthor$
  3409.     TEXT xb&+5,vert&,void$
  3410.     IF vert&-yb&>230
  3411.       TEXT xb&+5,vert&+14,"Press a key for more"
  3412.       GOSUB pause
  3413.       vert&=yb&+27
  3414.       CLEARW #sit&
  3415.       TEXT xb&+5,yb&+8,"List of Levels.    Free Memory: "+STR$(FRE(0))
  3416.       TEXT xb&+5,yb&+24,"NAME      MAP   GRAVITY  NEEDED  AUTHOR"
  3417.     ENDIF
  3418.     ADD vert&,9
  3419.   LOOP
  3420.   '
  3421.   void$="Levels: "+STR$(numlev&)
  3422.   IF numlev&>0
  3423.     void$=void$+"  Av. Diamonds: "+STR$(totdia&/numlev&)
  3424.   ENDIF
  3425.   TEXT xb&+5,vert&+14,void$
  3426.   default$=olddefault$
  3427.   GOSUB pause
  3428.   GOSUB fade(0)
  3429.   PUT 0,0,get1$
  3430.   PUT width& DIV 2,0,get2$
  3431.   GOSUB fade(15)
  3432. RETURN
  3433. PROCEDURE backplay
  3434.   pushywall&=0
  3435.   oldmanx&=manx&
  3436.   oldmany&=many&
  3437.   FOR f&=1 TO 20
  3438.     FOR g&=1 TO 30
  3439.       ob&(f&,g&)=b&(f&,g&)
  3440.       IF b&(f&,g&)=17
  3441.         INC pushywall&
  3442.       ENDIF
  3443.     NEXT g&
  3444.   NEXT f&
  3445.   GOSUB play
  3446.   FOR f&=1 TO 20
  3447.     FOR g&=1 TO 30
  3448.       b&(f&,g&)=ob&(f&,g&)
  3449.     NEXT g&
  3450.   NEXT f&
  3451.   many&=oldmany&
  3452.   manx&=oldmanx&
  3453. RETURN
  3454. '
  3455. ' Specials menu
  3456. PROCEDURE specials
  3457.   specmenu&=1
  3458.   GOSUB specset
  3459.   x$="Editor Specials Menu"
  3460.   GOSUB text(height&/2-80,1)
  3461.   GOSUB fadetwo(15)
  3462.   '
  3463.   GOSUB mouse
  3464.   oy&=height&-y&-40
  3465.   REPEAT
  3466.     joy&=STICK(1)
  3467.     ink$=INKEY$
  3468.     GOSUB mouse
  3469.     ospecmenu&=specmenu&
  3470.     IF (y&<height&/2-44 AND oy&>=height&/2-44)
  3471.       specmenu&=1
  3472.     ENDIF
  3473.     IF (y&>=height&/2-44 AND y&<height&/2-20 AND (oy&<height&/2-44 OR oy&=>height&/2-20))
  3474.       specmenu&=2
  3475.     ENDIF
  3476.     IF (y&>=height&/2-20 AND y&<height&/2+4 AND (oy&<height&/2-20 OR oy&=>height&/2+4))
  3477.       specmenu&=4
  3478.     ENDIF
  3479.     IF (y&>=height&/2+4 AND y&<height&/2+28 AND (oy&<height&/2+4 OR oy&=>height&/2+28))
  3480.       specmenu&=8
  3481.     ENDIF
  3482.     IF (y&>=height&/2+28 AND y&<height&/2+52 AND (oy&<height&/2+28 OR oy&=>height&/2+52))
  3483.       specmenu&=16
  3484.     ENDIF
  3485.     IF (y&>=height&/2+52 AND y&<height&/2+76 AND (oy&<height&/2+52 OR oy&=>height&/2+76))
  3486.       specmenu&=32
  3487.     ENDIF
  3488.     IF (y&>=height&/2+76 AND oy&<height&/2+100)
  3489.       specmenu&=64
  3490.     ENDIF
  3491.     IF joy&=1 OR ink$=CHR$(155)+CHR$(65)
  3492.       DIV specmenu&,2
  3493.     ENDIF
  3494.     IF joy&=2 OR ink$=CHR$(155)+CHR$(66)
  3495.       MUL specmenu&,2
  3496.     ENDIF
  3497.     IF specmenu&<1
  3498.       specmenu&=1
  3499.     ENDIF
  3500.     IF specmenu&>64
  3501.       specmenu&=64
  3502.     ENDIF
  3503.     IF specmenu&<>ospecmenu&
  3504.       GOSUB specset
  3505.     ENDIF
  3506.     IF joy&
  3507.       REPEAT
  3508.       UNTIL STICK(1)=0
  3509.     ENDIF
  3510.     oy&=y&
  3511.   UNTIL b& OR ink$=CHR$(13) OR STRIG(1)
  3512.   '
  3513.   GOSUB fadetwo(0)
  3514.   CLEARW #sit&
  3515. RETURN
  3516. PROCEDURE specset
  3517.   x$="Alter Level's Author"
  3518.   GOSUB text((height&/2)-36,SGN(specmenu& AND 1)+8)
  3519.   x$="Change Level Directory"
  3520.   GOSUB text((height&/2)-12,SGN(specmenu& AND 2)+8)
  3521.   x$="Splurge! the Level"
  3522.   GOSUB text((height&/2)+12,SGN(specmenu& AND 4)+8)
  3523.   x$="Curvify Walls"
  3524.   GOSUB text((height&/2)+36,SGN(specmenu& AND 8)+8)
  3525.   x$="Diagonalify Walls"
  3526.   GOSUB text((height&/2)+60,SGN(specmenu& AND 16)+8)
  3527.   x$="Swap Curves & Diagonals"
  3528.   GOSUB text((height&/2)+84,SGN(specmenu& AND 32)+8)
  3529.   x$="Return to Editor"
  3530.   GOSUB text((height&/2)+108,SGN(specmenu& AND 64)+8)
  3531. RETURN
  3532. PROCEDURE specs
  3533.   GET 0,0,width& DIV 2,height&,get1$
  3534.   GET width& DIV 2,0,width&,height&,get2$
  3535.   GOSUB fade(0)
  3536.   CLEARW #sit&
  3537.   GOSUB specials
  3538.   SELECT specmenu&
  3539.   CASE 1
  3540.     x$="Enter Author's Name:"
  3541.     GOSUB text((height&/2)-12,1)
  3542.     GOSUB fade(15)
  3543.     PRINT AT(width&/16-15,height&/16+1);
  3544.     FORM INPUT 32 AS author$
  3545.     GOSUB fade(0)
  3546.   CASE 2
  3547.     GOSUB directory
  3548.   CASE 4
  3549.     x$="Watch out! This operation will"
  3550.     GOSUB text((height&/2)-32,1)
  3551.     x$="devastate your level. Continue?"
  3552.     GOSUB text((height&/2)-22,1)
  3553.     GOSUB yesno
  3554.     PUT 0,0,get1$
  3555.     PUT width& DIV 2,0,get2$
  3556.     GOSUB fade(15)
  3557.     IF yesno&=1
  3558.       get1$="" ! Much needed memory
  3559.       get2$=""
  3560.       GOSUB splurge
  3561.     ENDIF
  3562.   CASE 8
  3563.     x$="Do you really want to change all the"
  3564.     GOSUB text((height&/2)-32,1)
  3565.     x$="walls so that the corners are curved?"
  3566.     GOSUB text((height&/2)-22,1)
  3567.     GOSUB yesno
  3568.     PUT 0,0,get1$
  3569.     PUT width& DIV 2,0,get2$
  3570.     GOSUB fade(15)
  3571.     IF yesno&=1
  3572.       GOSUB curvify
  3573.     ENDIF
  3574.   CASE 16
  3575.     x$="Do you really want to change all the"
  3576.     GOSUB text((height&/2)-32,1)
  3577.     x$="walls so the corners are diagonal?"
  3578.     GOSUB text((height&/2)-22,1)
  3579.     GOSUB yesno
  3580.     PUT 0,0,get1$
  3581.     PUT width& DIV 2,0,get2$
  3582.     GOSUB fade(15)
  3583.     IF yesno&=1
  3584.       GOSUB diagonalify
  3585.     ENDIF
  3586.   CASE 32
  3587.     x$="Do you really want to swap curved"
  3588.     GOSUB text((height&/2)-32,1)
  3589.     x$="walls with diagonal walls?"
  3590.     GOSUB text((height&/2)-22,1)
  3591.     GOSUB yesno
  3592.     PUT 0,0,get1$
  3593.     PUT width& DIV 2,0,get2$
  3594.     GOSUB fade(15)
  3595.     IF yesno&=1
  3596.       GOSUB swapify
  3597.     ENDIF
  3598.   ENDSELECT
  3599.   IF specmenu&<>4 AND specmenu&<>8 AND specmenu&<>16 AND specmenu&<>32
  3600.     PUT 0,0,get1$
  3601.     PUT width& DIV 2,0,get2$
  3602.     GOSUB fade(15)
  3603.   ENDIF
  3604. RETURN
  3605. PROCEDURE splurge
  3606.   '  SETCOLOR 0,8,0,0
  3607.   '
  3608.   ' Store level to use as data for Splurge!
  3609.   FOR f&=1 TO 20
  3610.     FOR g&=1 TO 30
  3611.       ob&(f&,g&)=b&(f&,g&)
  3612.     NEXT g&
  3613.   NEXT f&
  3614.   '
  3615.   FOR f&=2 TO 29
  3616.     FOR g&=2 TO 19
  3617.       b&(g&,f&)=-1
  3618.     NEXT g&
  3619.   NEXT f&
  3620.   '
  3621.   ARRAYFILL tele&(),0
  3622.   DEFFILL 0
  3623.   PBOX xb&+16,yb&+16,xb&+239,yb&+159
  3624.   PBOX xb&,yb&+171,xb&+221,yb&+171+98
  3625.   COLOR 1
  3626.   TEXT xb&+15,yb&+209,"This may take some time."
  3627.   TEXT xb&+3,yb&+219,"If you get bored, push Esc."
  3628.   manx&=-1
  3629.   many&=-1
  3630.   '
  3631.   filled&=0
  3632.   '
  3633.   finish!=FALSE
  3634.   FOR loop&=1 TO 2500
  3635.     f&=RANDOM(28)+2
  3636.     g&=RANDOM(18)+2
  3637.     GOSUB splurgesquare
  3638.     i$=INKEY$
  3639.     IF i$=CHR$(27)
  3640.       finish!=TRUE
  3641.     ENDIF
  3642.     EXIT IF finish!
  3643.   NEXT loop&
  3644.   '
  3645.   FOR f&=2 TO 29
  3646.     FOR g&=2 TO 19
  3647.       GOSUB splurgesquare
  3648.       i$=INKEY$
  3649.       IF i$=CHR$(27)
  3650.         finish!=TRUE
  3651.       ENDIF
  3652.       EXIT IF finish!
  3653.     NEXT g&
  3654.     EXIT IF finish!
  3655.   NEXT f&
  3656.   '
  3657.   FOR f&=2 TO 29
  3658.     FOR g&=2 TO 19
  3659.       IF b&(g&,f&)=-1
  3660.         b&(g&,f&)=0
  3661.       ENDIF
  3662.     NEXT g&
  3663.   NEXT f&
  3664.   '
  3665.   IF manx&=-1 OR many&=-1
  3666.     manx&=RANDOM(28)+2
  3667.     many&=RANDOM(18)+2
  3668.     PUT manx&*8+xb&,many&*8+yb&,mini$(2)
  3669.     b&(many&,manx&)=2
  3670.   ENDIF
  3671.   '
  3672.   GOSUB maxdiamonds
  3673.   '
  3674.   author$="Splurge! (from "+default$+")"
  3675.   '
  3676.   default$=UPPER$("SPLURGE!")
  3677.   GOSUB encode
  3678.   PRINT AT(36,28+kon&);SPACE$(8)
  3679.   PRINT AT(36,28+kon&);default$
  3680.   PRINT AT(36,26+kon&);SPACE$(8)
  3681.   PRINT AT(36,26+kon&);encoded$
  3682.   next$="NONE"
  3683.   PRINT AT(36,30+kon&);SPACE$(8)
  3684.   PRINT AT(36,30+kon&);next$
  3685.   '
  3686.   IF tog&=0
  3687.     PUT xb&,yb&+171,tog0$
  3688.   ELSE
  3689.     PUT xb&,yb&+171,tog1$
  3690.   ENDIF
  3691.   '
  3692.   SETCOLOR 0,0,0,0
  3693. RETURN
  3694. PROCEDURE flattoother
  3695.   FOR f&=1 TO 20
  3696.     FOR g&=1 TO 30
  3697.       here&=b&(f&,g&)
  3698.       IF here&<>8 AND here&<>9 AND here&<>11 AND here&<>12 AND here&<>23 AND here&<>24 AND here&<>25 AND here&<>26 AND here&<>29 AND here&<>17 AND here&<>32 AND here&<>33 AND here&<>34 AND here&<>35 AND (here&<36 OR here&>40)
  3699.         ob&(f&,g&)=here&
  3700.       ELSE
  3701.         ob&(f&,g&)=4
  3702.       ENDIF
  3703.     NEXT g&
  3704.   NEXT f&
  3705. RETURN
  3706. PROCEDURE curvify
  3707.   GOSUB flattoother
  3708.   '
  3709.   FOR f&=1 TO 20
  3710.     FOR g&=1 TO 30
  3711.       IF ob&(f&,g&)=4
  3712.         PUT g&*8+xb&,f&*8+yb&,mini$(17)
  3713.         tally&=0
  3714.         IF ob&(f&-1,g&)=4 ! Up
  3715.           ADD tally&,8
  3716.         ENDIF
  3717.         IF ob&(f&+1,g&)=4 ! Down
  3718.           ADD tally&,4
  3719.         ENDIF
  3720.         IF ob&(f&,g&-1)=4 ! Left
  3721.           ADD tally&,2
  3722.         ENDIF
  3723.         IF ob&(f&,g&+1)=4 ! Right
  3724.           ADD tally&,1
  3725.         ENDIF
  3726.         SELECT tally&
  3727.         CASE 10
  3728.           here&=11
  3729.         CASE 9
  3730.           here&=12
  3731.         CASE 6
  3732.           here&=8
  3733.         CASE 5
  3734.           here&=9
  3735.         CASE 0
  3736.           here&=29
  3737.         CASE 8
  3738.           here&=24
  3739.         CASE 4
  3740.           here&=23
  3741.         CASE 2
  3742.           here&=26
  3743.         CASE 1
  3744.           here&=25
  3745.         DEFAULT
  3746.           here&=4
  3747.         ENDSELECT
  3748.         IF b&(f&,g&)=17
  3749.           here&=17
  3750.         ENDIF
  3751.         b&(f&,g&)=here&
  3752.         PUT g&*8+xb&,f&*8+yb&,mini$(b&(f&,g&))
  3753.       ENDIF
  3754.     NEXT g&
  3755.   NEXT f&
  3756. RETURN
  3757. PROCEDURE diagonalify
  3758.   GOSUB flattoother
  3759.   '
  3760.   FOR f&=1 TO 20
  3761.     FOR g&=1 TO 30
  3762.       IF ob&(f&,g&)=4
  3763.         PUT g&*8+xb&,f&*8+yb&,mini$(17)
  3764.         tally&=0
  3765.         IF ob&(f&-1,g&)=4 ! Up
  3766.           ADD tally&,8
  3767.         ENDIF
  3768.         IF ob&(f&+1,g&)=4 ! Down
  3769.           ADD tally&,4
  3770.         ENDIF
  3771.         IF ob&(f&,g&-1)=4 ! Left
  3772.           ADD tally&,2
  3773.         ENDIF
  3774.         IF ob&(f&,g&+1)=4 ! Right
  3775.           ADD tally&,1
  3776.         ENDIF
  3777.         SELECT tally&
  3778.         CASE 10
  3779.           here&=35
  3780.         CASE 9
  3781.           here&=34
  3782.         CASE 6
  3783.           here&=33
  3784.         CASE 5
  3785.           here&=32
  3786.         CASE 0
  3787.           here&=40
  3788.         CASE 8
  3789.           here&=38
  3790.         CASE 4
  3791.           here&=36
  3792.         CASE 2
  3793.           here&=37
  3794.         CASE 1
  3795.           here&=39
  3796.         DEFAULT
  3797.           here&=4
  3798.         ENDSELECT
  3799.         IF b&(f&,g&)=17
  3800.           here&=17
  3801.         ENDIF
  3802.         b&(f&,g&)=here&
  3803.         PUT g&*8+xb&,f&*8+yb&,mini$(b&(f&,g&))
  3804.       ENDIF
  3805.     NEXT g&
  3806.   NEXT f&
  3807. RETURN
  3808. PROCEDURE swapify
  3809.   GOSUB flattoother
  3810.   '
  3811.   FOR f&=1 TO 20
  3812.     FOR g&=1 TO 30
  3813.       IF ob&(f&,g&)=4
  3814.         PUT g&*8+xb&,f&*8+yb&,mini$(17)
  3815.         SELECT b&(f&,g&)
  3816.         CASE 8
  3817.           here&=33
  3818.         CASE 33
  3819.           here&=8
  3820.         CASE 9
  3821.           here&=32
  3822.         CASE 32
  3823.           here&=9
  3824.         CASE 11
  3825.           here&=35
  3826.         CASE 35
  3827.           here&=11
  3828.         CASE 12
  3829.           here&=34
  3830.         CASE 34
  3831.           here&=12
  3832.         CASE 23
  3833.           here&=36
  3834.         CASE 36
  3835.           here&=23
  3836.         CASE 24
  3837.           here&=38
  3838.         CASE 38
  3839.           here&=24
  3840.         CASE 25
  3841.           here&=39
  3842.         CASE 39
  3843.           here&=25
  3844.         CASE 26
  3845.           here&=37
  3846.         CASE 37
  3847.           here&=26
  3848.         CASE 29
  3849.           here&=40
  3850.         CASE 40
  3851.           here&=29
  3852.         DEFAULT
  3853.           here&=b&(f&,g&)
  3854.         ENDSELECT
  3855.         b&(f&,g&)=here&
  3856.         PUT g&*8+xb&,f&*8+yb&,mini$(b&(f&,g&))
  3857.       ENDIF
  3858.     NEXT g&
  3859.   NEXT f&
  3860. RETURN
  3861. PROCEDURE splurgesquare
  3862.   IF b&(g&+1,f&)<>-1 OR b&(g&-1,f&)<>-1 OR b&(g&,f&+1)<>-1 OR b&(g&,f&-1)<>-1 ! Ensure some trigger
  3863.     IF b&(g&,f&)=-1
  3864.       counter&=0
  3865.       donebar!=FALSE   ! Duh. Dum bah.
  3866.       ARRAYFILL match&(),-1
  3867.       REPEAT
  3868.         REPEAT
  3869.           spf&=RANDOM(28)+2
  3870.           spg&=RANDOM(18)+2
  3871.         UNTIL ob&(spg&,spf&)<>27 AND ob&(spg&,spf&)<>31 AND (ob&(spg&,spf&)<>2 OR manx&=-1 OR many&=-1)
  3872.         match&=0
  3873.         IF ob&(spg&+1,spf&)=b&(g&+1,f&) OR b&(g&+1,f&)=-1
  3874.           INC match&
  3875.         ENDIF
  3876.         IF ob&(spg&-1,spf&)=b&(g&-1,f&) OR b&(g&-1,f&)=-1
  3877.           INC match&
  3878.         ENDIF
  3879.         IF ob&(spg&,spf&+1)=b&(g&,f&+1) OR b&(g&,f&+1)=-1
  3880.           INC match&
  3881.         ENDIF
  3882.         IF ob&(spg&,spf&-1)=b&(g&,f&-1) OR b&(g&,f&-1)=-1
  3883.           INC match&
  3884.         ENDIF
  3885.         match&(match&)=ob&(spg&,spf&)
  3886.         INC counter&
  3887.       UNTIL counter&>=1200 OR match&(4)<>-1
  3888.       '
  3889.       b&(g&,f&)=ob&(spg&,spf&)
  3890.       FOR zoomerama&=1 TO 4
  3891.         IF match&(zoomerama&)<>-1
  3892.           b&(g&,f&)=match&(zoomerama&)
  3893.         ENDIF
  3894.       NEXT zoomerama&
  3895.       INC filled&
  3896.       TEXT xb&+100,yb&+239,STR$(100*filled& DIV (28*18),3)+"%"
  3897.       '
  3898.       IF b&(g&,f&)=2
  3899.         manx&=f&
  3900.         many&=g&
  3901.       ENDIF
  3902.       PUT f&*8+xb&,g&*8+yb&,mini$(b&(g&,f&))
  3903.     ENDIF
  3904.   ENDIF
  3905. RETURN
  3906. '
  3907. ' Sound
  3908. PROCEDURE soundinit
  3909.   sound!=FALSE
  3910.   '
  3911.   saquiet%=AllocMem(16,65538)
  3912.   hardbase%=14675968   ! hardware regs base address
  3913.   salen%=51940
  3914.   soundfile$="PlasmaSounds"
  3915.   samem%=AllocMem(salen%,65538)
  3916.   samchan%=0
  3917.   '
  3918.   IF samem%<=0 OR saquiet%<=0
  3919.     x$="Insufficient chip memory to load"
  3920.     GOSUB text((height&/2)-20,1)
  3921.     x$="sounds in. Free some before running,"
  3922.     GOSUB text((height&/2),1)
  3923.     x$="buy a memory expansion or go without."
  3924.     GOSUB text((height&/2)+20,1)
  3925.     GOSUB fade(15)
  3926.     GOSUB pause
  3927.     GOSUB fade(0)
  3928.     CLEARW #sit&
  3929.     GOSUB soundquit
  3930.     GOTO ret2
  3931.   ENDIF
  3932.   '
  3933.   IF NOT (EXIST(soundfile$))
  3934.     FRONTS sit&
  3935.     x$="Unable to find the sound file called"
  3936.     GOSUB text((height&/2)-30,1)
  3937.     x$=""""+soundfile$+""". If you want sounds"
  3938.     GOSUB text((height&/2)-10,1)
  3939.     x$="then put that file in the current"
  3940.     GOSUB text((height&/2)+10,1)
  3941.     x$="directory before running."
  3942.     GOSUB text((height&/2)+30,1)
  3943.     GOSUB fade(15)
  3944.     GOSUB pause
  3945.     GOSUB fade(0)
  3946.     CLEARW #sit&
  3947.     GOSUB soundquit
  3948.     GOTO ret2
  3949.   ELSE
  3950.     FRONTS sit&
  3951.     BLOAD soundfile$,samem%
  3952.     FRONTS sit&
  3953.     sound!=TRUE
  3954.   ENDIF
  3955.   ret2:
  3956. RETURN
  3957. PROCEDURE soundplay(samnum%,invol%)
  3958.   RESTORE sounddata
  3959.   IF sound!
  3960.     SELECT samchan%
  3961.     CASE 0
  3962.       samchan%=1
  3963.     CASE 1
  3964.       samchan%=3
  3965.     CASE 3
  3966.       samchan%=2
  3967.     CASE 2
  3968.       samchan%=0
  3969.     ENDSELECT
  3970.     FRONTS sit&
  3971.     samrep!=FALSE
  3972.     samadr%=samem%
  3973.     samlen%=0
  3974.     FOR whichisit%=1 TO ABS(samnum%)
  3975.       ADD samadr%,samlen%
  3976.       READ samlen%,samper%
  3977.     NEXT whichisit%
  3978.     samlen%=samlen%/2 ! In words not bytes
  3979.     samvol%=invol%
  3980.     GOSUB sam ! Play it again, Sam! (sorry, couldn't resist)
  3981.   ENDIF
  3982.   sounddata:
  3983.   DATA 0,307
  3984.   DATA 51940,400
  3985. RETURN
  3986. PROCEDURE soundquit
  3987.   DPOKE hardbase%+150,1+2+4+8 ! turn off playing of blank sounds
  3988.   IF samem%>0
  3989.     VOID FreeMem(samem%,salen%)
  3990.   ENDIF
  3991.   IF saquiet%>0
  3992.     VOID FreeMem(saquiet%,16)
  3993.   ENDIF
  3994. RETURN
  3995. PROCEDURE sam
  3996.   ' Illegaly play sample, going
  3997.   ' against all the usual prinicpals
  3998.   ' of shared resources in a multitasking
  3999.   ' environment:
  4000.   ADD hardbase%,samchan%*16
  4001.   PAUSE 1
  4002.   LPOKE hardbase%+160,samadr%           ! start
  4003.   DPOKE hardbase%+164,samlen%           ! length
  4004.   DPOKE hardbase%+166,samper%           ! speed (period)
  4005.   DPOKE hardbase%+168,samvol%               ! volume
  4006.   DPOKE hardbase%+150-samchan%*16,33280+2^samchan% ! start audio DMA
  4007.   '
  4008.   IF NOT rep!
  4009.     LPOKE hardbase%+160,saquiet%        ! turn off sample after, by repeated playing
  4010.     DPOKE hardbase%+164,1               ! of an empty word at saquiet%
  4011.     DPOKE hardbase%+150-samchan%*16,33280+2^samchan%
  4012.   ENDIF
  4013.   '
  4014.   SUB hardbase%,samchan%*16
  4015.   ' Let's hit that metal! Humn.
  4016. RETURN
  4017.